(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

type t = Raw_context.t

type context = t

module type BASIC_DATA = sig
  type t

  include Compare.S with type t := t

  val encoding : t Data_encoding.t

  val pp : Format.formatter -> t -> unit
end

module Tez = Tez_repr
module Period = Period_repr

module Timestamp = struct
  include Time_repr

  let current = Raw_context.current_timestamp
end

include Operation_repr

module Operation = struct
  type 'kind t = 'kind operation = {
    shell : Operation.shell_header;
    protocol_data : 'kind protocol_data;
  }

  type packed = packed_operation

  let unsigned_encoding = unsigned_operation_encoding

  include Operation_repr
end

module Block_header = Block_header_repr

module Vote = struct
  include Vote_repr
  include Vote_storage
end

module Raw_level = Raw_level_repr
module Cycle = Cycle_repr
module Script_int = Script_int_repr

module Script_timestamp = struct
  include Script_timestamp_repr

  let now ctxt =
    let {Constants_repr.time_between_blocks; _} = Raw_context.constants ctxt in
    match time_between_blocks with
    | [] ->
        failwith
          "Internal error: 'time_between_block' constants is an empty list."
    | first_delay :: _ ->
        let current_timestamp = Raw_context.predecessor_timestamp ctxt in
        Time.add current_timestamp (Period_repr.to_seconds first_delay)
        |> Timestamp.to_seconds |> of_int64
end

module Script = struct
  include Michelson_v1_primitives
  include Script_repr

  let force_decode ctxt lexpr =
    Lwt.return
      ( Script_repr.force_decode lexpr
      >>? fun (v, cost) ->
      Raw_context.consume_gas ctxt cost >|? fun ctxt -> (v, ctxt) )

  let force_bytes ctxt lexpr =
    Lwt.return
      ( Script_repr.force_bytes lexpr
      >>? fun (b, cost) ->
      Raw_context.consume_gas ctxt cost >|? fun ctxt -> (b, ctxt) )

  module Legacy_support = Legacy_script_support_repr
end

module Fees = Fees_storage

type public_key = Signature.Public_key.t

type public_key_hash = Signature.Public_key_hash.t

type signature = Signature.t

module Constants = struct
  include Constants_repr
  include Constants_storage
end

module Voting_period = Voting_period_repr

module Gas = struct
  include Gas_limit_repr

  type error += Gas_limit_too_high = Raw_context.Gas_limit_too_high

  let check_limit = Raw_context.check_gas_limit

  let set_limit = Raw_context.set_gas_limit

  let set_unlimited = Raw_context.set_gas_unlimited

  let consume = Raw_context.consume_gas

  let check_enough = Raw_context.check_enough_gas

  let level = Raw_context.gas_level

  let consumed = Raw_context.gas_consumed

  let block_level = Raw_context.block_gas_level
end

module Level = struct
  include Level_repr
  include Level_storage
end

module Contract = struct
  include Contract_repr
  include Contract_storage

  let originate c contract ~balance ~script ~delegate =
    originate c contract ~balance ~script ~delegate

  let init_origination_nonce = Raw_context.init_origination_nonce

  let unset_origination_nonce = Raw_context.unset_origination_nonce
end

module Big_map = struct
  type id = Z.t

  let fresh = Storage.Big_map.Next.incr

  let fresh_temporary = Raw_context.fresh_temporary_big_map

  let mem c m k = Storage.Big_map.Contents.mem (c, m) k

  let get_opt c m k = Storage.Big_map.Contents.get_option (c, m) k

  let rpc_arg = Storage.Big_map.rpc_arg

  let cleanup_temporary c =
    Raw_context.temporary_big_maps c Storage.Big_map.remove_rec c
    >>= fun c -> Lwt.return (Raw_context.reset_temporary_big_map c)

  let exists c id =
    Lwt.return
      (Raw_context.consume_gas c (Gas_limit_repr.read_bytes_cost Z.zero))
    >>=? fun c ->
    Storage.Big_map.Key_type.get_option c id
    >>=? fun kt ->
    match kt with
    | None ->
        return (c, None)
    | Some kt ->
        Storage.Big_map.Value_type.get c id
        >>=? fun kv -> return (c, Some (kt, kv))
end

module Delegate = Delegate_storage

module Roll = struct
  include Roll_repr
  include Roll_storage
end

module Nonce = Nonce_storage

module Seed = struct
  include Seed_repr
  include Seed_storage
end

module Fitness = struct
  include Fitness_repr
  include Fitness

  type fitness = t

  include Fitness_storage
end

module Bootstrap = Bootstrap_storage

module Commitment = struct
  include Commitment_repr
  include Commitment_storage
end

module Global = struct
  let get_block_priority = Storage.Block_priority.get

  let set_block_priority = Storage.Block_priority.set
end

let prepare_first_block = Init_storage.prepare_first_block

let prepare = Init_storage.prepare

let finalize ?commit_message:message c =
  let fitness = Fitness.from_int64 (Fitness.current c) in
  let context = Raw_context.recover c in
  {
    Updater.context;
    fitness;
    message;
    max_operations_ttl = 60;
    last_allowed_fork_level =
      Raw_level.to_int32 @@ Level.last_allowed_fork_level c;
  }

let activate = Raw_context.activate

let fork_test_chain = Raw_context.fork_test_chain

let record_endorsement = Raw_context.record_endorsement

let allowed_endorsements = Raw_context.allowed_endorsements

let init_endorsements = Raw_context.init_endorsements

let included_endorsements = Raw_context.included_endorsements

let reset_internal_nonce = Raw_context.reset_internal_nonce

let fresh_internal_nonce = Raw_context.fresh_internal_nonce

let record_internal_nonce = Raw_context.record_internal_nonce

let internal_nonce_already_recorded =
  Raw_context.internal_nonce_already_recorded

let add_deposit = Raw_context.add_deposit

let add_fees = Raw_context.add_fees

let add_rewards = Raw_context.add_rewards

let get_deposits = Raw_context.get_deposits

let get_fees = Raw_context.get_fees

let get_rewards = Raw_context.get_rewards

let description = Raw_context.description

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Definition t := Tezos_raw_protocol_alpha.Raw_context.t.

Definition context := t.

Module BASIC_DATA.
  Record signature {t : Set} := {
    t := t;
    op_eq : t -> t -> bool;
    op_ltgt : t -> t -> bool;
    op_lt : t -> t -> bool;
    op_lteq : t -> t -> bool;
    op_gteq : t -> t -> bool;
    op_gt : t -> t -> bool;
    compare : t -> t -> Z;
    equal : t -> t -> bool;
    max : t -> t -> t;
    min : t -> t -> t;
    encoding : Tezos_protocol_environment_alpha__Environment.Data_encoding.t t;
    pp :
      Tezos_protocol_environment_alpha__Environment.Format.formatter -> t ->
      unit;
  }.
  Arguments signature : clear implicits.
End BASIC_DATA.

Module Tez := Tez_repr.

Module Period := Period_repr.

Module Timestamp.
  Export Time_repr.
  
  Definition current
    : Tezos_raw_protocol_alpha.Raw_context.context ->
    Tezos_protocol_environment_alpha__Environment.Time.t :=
    Raw_context.current_timestamp.
End Timestamp.

Export Operation_repr.

Module Operation.
  Module t.
    Record record {kind : Set} := {
      shell :
        Tezos_protocol_environment_alpha__Environment.Operation.shell_header;
      protocol_data : protocol_data kind }.
    Arguments record : clear implicits.
  End t.
  Definition t := t.record.
  
  Definition packed := packed_operation.
  
  Definition unsigned_encoding
    : Tezos_protocol_environment_alpha__Environment.Data_encoding.t
      (Tezos_protocol_environment_alpha__Environment.Operation.shell_header *
        packed_contents_list) := unsigned_operation_encoding.
  
  Export Operation_repr.
End Operation.

Module Block_header := Block_header_repr.

Module Vote.
  Export Vote_repr.
  
  Export Vote_storage.
End Vote.

Module Raw_level := Raw_level_repr.

Module Cycle := Cycle_repr.

Module Script_int := Script_int_repr.

Module Script_timestamp.
  Export Script_timestamp_repr.
  
  Definition now (ctxt : Tezos_raw_protocol_alpha.Raw_context.context) : t :=
    let '{|
      Tezos_raw_protocol_alpha.Constants_repr.parametric.time_between_blocks :=
        time_between_blocks
        |} := Raw_context.constants ctxt in
    match time_between_blocks with
    | [] =>
      failwith
        "Internal error: 'time_between_block' constants is an empty list." %
          string
    | cons first_delay _ =>
      let current_timestamp := Raw_context.predecessor_timestamp ctxt in
      op_pipegt
        (op_pipegt
          (Time.add current_timestamp (Period_repr.to_seconds first_delay))
          Timestamp.to_seconds) of_int64
    end.
End Script_timestamp.

Module Script.
  Export Michelson_v1_primitives.
  
  Export Script_repr.
  
  Definition force_decode
    (ctxt : Tezos_raw_protocol_alpha.Raw_context.context)
    (lexpr : Tezos_raw_protocol_alpha.Script_repr.lazy_expr)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (Tezos_raw_protocol_alpha.Script_repr.expr *
          Tezos_raw_protocol_alpha.Raw_context.context)) :=
    Lwt.__return
      (op_gtgtquestion (Script_repr.force_decode lexpr)
        (fun function_parameter =>
          let '(v, cost) := function_parameter in
          op_gtpipequestion (Raw_context.consume_gas ctxt cost)
            (fun ctxt => (v, ctxt)))).
  
  Definition force_bytes
    (ctxt : Tezos_raw_protocol_alpha.Raw_context.context)
    (lexpr : Tezos_raw_protocol_alpha.Script_repr.lazy_expr)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (Tezos_protocol_environment_alpha__Environment.MBytes.t *
          Tezos_raw_protocol_alpha.Raw_context.context)) :=
    Lwt.__return
      (op_gtgtquestion (Script_repr.force_bytes lexpr)
        (fun function_parameter =>
          let '(b, cost) := function_parameter in
          op_gtpipequestion (Raw_context.consume_gas ctxt cost)
            (fun ctxt => (b, ctxt)))).
  
  Module Legacy_support := Legacy_script_support_repr.
End Script.

Module Fees := Fees_storage.

Definition public_key :=
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t.

Definition public_key_hash :=
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t.

Definition signature :=
  Tezos_protocol_environment_alpha__Environment.Signature.t.

Module Constants.
  Export Constants_repr.
  
  Export Constants_storage.
End Constants.

Module Voting_period := Voting_period_repr.

Module Gas.
  Export Gas_limit_repr.
  
  (* ❌ Structure item `typext` not handled. *)
  type_extension
  
  Definition check_limit
    : Tezos_raw_protocol_alpha.Raw_context.t ->
    Tezos_protocol_environment_alpha__Environment.Z.t ->
    Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit :=
    Raw_context.check_gas_limit.
  
  Definition set_limit
    : Tezos_raw_protocol_alpha.Raw_context.t ->
    Tezos_protocol_environment_alpha__Environment.Z.t ->
    Tezos_raw_protocol_alpha.Raw_context.t := Raw_context.set_gas_limit.
  
  Definition set_unlimited
    : Tezos_raw_protocol_alpha.Raw_context.t ->
    Tezos_raw_protocol_alpha.Raw_context.t := Raw_context.set_gas_unlimited.
  
  Definition consume
    : Tezos_raw_protocol_alpha.Raw_context.context ->
    Tezos_raw_protocol_alpha.Gas_limit_repr.cost ->
    Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.context := Raw_context.consume_gas.
  
  Definition check_enough
    : Tezos_raw_protocol_alpha.Raw_context.context ->
    Tezos_raw_protocol_alpha.Gas_limit_repr.cost ->
    Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit :=
    Raw_context.check_enough_gas.
  
  Definition level
    : Tezos_raw_protocol_alpha.Raw_context.t ->
    Tezos_raw_protocol_alpha.Gas_limit_repr.t := Raw_context.gas_level.
  
  Definition consumed
    : Tezos_raw_protocol_alpha.Raw_context.t ->
    Tezos_raw_protocol_alpha.Raw_context.t ->
    Tezos_protocol_environment_alpha__Environment.Z.t :=
    Raw_context.gas_consumed.
  
  Definition block_level
    : Tezos_raw_protocol_alpha.Raw_context.t ->
    Tezos_protocol_environment_alpha__Environment.Z.t :=
    Raw_context.block_gas_level.
End Gas.

Module Level.
  Export Level_repr.
  
  Export Level_storage.
End Level.

Module Contract.
  Export Contract_repr.
  
  Export Contract_storage.
  
  Definition originate
    (c : Tezos_raw_protocol_alpha.Raw_context.t)
    (contract : Tezos_raw_protocol_alpha.Contract_repr.t)
    (balance : Tezos_raw_protocol_alpha.Tez_repr.t)
    (script : Tezos_raw_protocol_alpha.Script_repr.t * option big_map_diff)
    (delegate :
      option
        Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        Tezos_raw_protocol_alpha.Raw_context.t) :=
    originate c None contract balance script delegate.
  
  Definition init_origination_nonce
    : Tezos_raw_protocol_alpha.Raw_context.t ->
    Tezos_protocol_environment_alpha__Environment.Operation_hash.t ->
    Tezos_raw_protocol_alpha.Raw_context.t := Raw_context.init_origination_nonce.
  
  Definition unset_origination_nonce
    : Tezos_raw_protocol_alpha.Raw_context.t ->
    Tezos_raw_protocol_alpha.Raw_context.t :=
    Raw_context.unset_origination_nonce.
End Contract.

Module Big_map.
  Definition id := Tezos_protocol_environment_alpha__Environment.Z.t.
  
  Definition fresh
    : Tezos_raw_protocol_alpha.Raw_context.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (Tezos_raw_protocol_alpha.Raw_context.t *
          Tezos_protocol_environment_alpha__Environment.Z.t)) :=
    Storage.Big_map.Next.incr.
  
  Definition fresh_temporary
    : Tezos_raw_protocol_alpha.Raw_context.context ->
    Tezos_raw_protocol_alpha.Raw_context.context *
      Tezos_protocol_environment_alpha__Environment.Z.t :=
    Raw_context.fresh_temporary_big_map.
  
  Definition mem
    (c : Tezos_raw_protocol_alpha.Raw_context.t)
    (m : Tezos_protocol_environment_alpha__Environment.Z.t)
    (k : Tezos_raw_protocol_alpha.Storage.Big_map.Contents.key)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (Tezos_raw_protocol_alpha.Raw_context.t * bool)) :=
    Storage.Big_map.Contents.mem (c, m) k.
  
  Definition get_opt
    (c : Tezos_raw_protocol_alpha.Raw_context.t)
    (m : Tezos_protocol_environment_alpha__Environment.Z.t)
    (k : Tezos_raw_protocol_alpha.Storage.Big_map.Contents.key)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (Tezos_raw_protocol_alpha.Raw_context.t *
          option Tezos_raw_protocol_alpha.Storage.Big_map.Contents.value)) :=
    Storage.Big_map.Contents.get_option (c, m) k.
  
  Definition rpc_arg
    : Tezos_protocol_environment_alpha__Environment.RPC_arg.t
      Tezos_protocol_environment_alpha__Environment.Z.t :=
    Storage.Big_map.rpc_arg.
  
  Definition cleanup_temporary
    (c : Tezos_raw_protocol_alpha.Raw_context.context)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      Tezos_raw_protocol_alpha.Raw_context.context :=
    op_gtgteq (Raw_context.temporary_big_maps c Storage.Big_map.remove_rec c)
      (fun c => Lwt.__return (Raw_context.reset_temporary_big_map c)).
  
  Definition __exists
    (c : Tezos_raw_protocol_alpha.Raw_context.context)
    (id : Tezos_raw_protocol_alpha.Storage.Big_map.Key_type.key)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (Tezos_raw_protocol_alpha.Raw_context.context *
          option
            (Tezos_raw_protocol_alpha.Storage.Big_map.Key_type.value *
              Tezos_raw_protocol_alpha.Storage.Big_map.Value_type.value))) :=
    op_gtgteqquestion
      (Lwt.__return
        (Raw_context.consume_gas c (Gas_limit_repr.read_bytes_cost Z.zero)))
      (fun c =>
        op_gtgteqquestion (Storage.Big_map.Key_type.get_option c id)
          (fun kt =>
            match kt with
            | None => __return (c, None)
            | Some kt =>
              op_gtgteqquestion (Storage.Big_map.Value_type.get c id)
                (fun kv => __return (c, (Some (kt, kv))))
            end)).
End Big_map.

Module Delegate := Delegate_storage.

Module Roll.
  Export Roll_repr.
  
  Export Roll_storage.
End Roll.

Module Nonce := Nonce_storage.

Module Seed.
  Export Seed_repr.
  
  Export Seed_storage.
End Seed.

Module Fitness.
  Export Fitness_repr.
  
  Export Fitness.
  
  Definition fitness := t.
  
  Export Fitness_storage.
End Fitness.

Module Bootstrap := Bootstrap_storage.

Module Commitment.
  Export Commitment_repr.
  
  Export Commitment_storage.
End Commitment.

Module Global.
  Definition get_block_priority
    : Tezos_raw_protocol_alpha.Raw_context.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult Z) :=
    Storage.Block_priority.get.
  
  Definition set_block_priority
    : Tezos_raw_protocol_alpha.Raw_context.t -> Z ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        Tezos_raw_protocol_alpha.Raw_context.t) := Storage.Block_priority.set.
End Global.

Definition prepare_first_block
  : Tezos_protocol_environment_alpha__Environment.Context.t ->
  (Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Script_repr.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      ((Tezos_raw_protocol_alpha.Script_repr.t *
        option Tezos_raw_protocol_alpha.Contract_storage.big_map_diff) *
        Tezos_raw_protocol_alpha.Raw_context.t))) -> int32 ->
  Tezos_protocol_environment_alpha__Environment.Time.t ->
  Tezos_protocol_environment_alpha__Environment.Fitness.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  Init_storage.prepare_first_block.

Definition prepare
  : Tezos_protocol_environment_alpha__Environment.Context.t ->
  Tezos_protocol_environment_alpha__Environment.Int32.t ->
  Tezos_protocol_environment_alpha__Environment.Time.t ->
  Tezos_protocol_environment_alpha__Environment.Time.t ->
  Tezos_protocol_environment_alpha__Environment.Fitness.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.context) := Init_storage.prepare.

Definition finalize
  (message : option string) (c : Tezos_raw_protocol_alpha.Raw_context.context)
  : Tezos_protocol_environment_alpha__Environment.Updater.validation_result :=
  let fitness := Fitness.from_int64 (Fitness.current c) in
  let context := Raw_context.recover c in
  {|
    Tezos_protocol_environment_alpha__Environment.Updater.validation_result.context :=
      context;
    Tezos_protocol_environment_alpha__Environment.Updater.validation_result.fitness :=
      fitness;
    Tezos_protocol_environment_alpha__Environment.Updater.validation_result.message :=
      message;
    Tezos_protocol_environment_alpha__Environment.Updater.validation_result.max_operations_ttl :=
      60;
    Tezos_protocol_environment_alpha__Environment.Updater.validation_result.last_allowed_fork_level :=
      op_atat Raw_level.to_int32 (Level.last_allowed_fork_level c) |}.

Definition activate
  : Tezos_raw_protocol_alpha.Raw_context.context ->
  Tezos_protocol_environment_alpha__Environment.Protocol_hash.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    Tezos_raw_protocol_alpha.Raw_context.t := Raw_context.activate.

Definition fork_test_chain
  : Tezos_raw_protocol_alpha.Raw_context.context ->
  Tezos_protocol_environment_alpha__Environment.Protocol_hash.t ->
  Tezos_protocol_environment_alpha__Environment.Time.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    Tezos_raw_protocol_alpha.Raw_context.t := Raw_context.fork_test_chain.

Definition record_endorsement
  : Tezos_raw_protocol_alpha.Raw_context.context ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Tezos_raw_protocol_alpha.Raw_context.context := Raw_context.record_endorsement.

Definition allowed_endorsements
  : Tezos_raw_protocol_alpha.Raw_context.context ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.Map.t
    (Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t *
      list Z * bool) := Raw_context.allowed_endorsements.

Definition init_endorsements
  : Tezos_raw_protocol_alpha.Raw_context.context ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.Map.t
    (Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t *
      list Z * bool) -> Tezos_raw_protocol_alpha.Raw_context.context :=
  Raw_context.init_endorsements.

Definition included_endorsements
  : Tezos_raw_protocol_alpha.Raw_context.context -> Z :=
  Raw_context.included_endorsements.

Definition reset_internal_nonce
  : Tezos_raw_protocol_alpha.Raw_context.context ->
  Tezos_raw_protocol_alpha.Raw_context.context :=
  Raw_context.reset_internal_nonce.

Definition fresh_internal_nonce
  : Tezos_raw_protocol_alpha.Raw_context.context ->
  Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (Tezos_raw_protocol_alpha.Raw_context.context * Z) :=
  Raw_context.fresh_internal_nonce.

Definition record_internal_nonce
  : Tezos_raw_protocol_alpha.Raw_context.context -> Z ->
  Tezos_raw_protocol_alpha.Raw_context.context :=
  Raw_context.record_internal_nonce.

Definition internal_nonce_already_recorded
  : Tezos_raw_protocol_alpha.Raw_context.context -> Z -> bool :=
  Raw_context.internal_nonce_already_recorded.

Definition add_deposit
  : Tezos_raw_protocol_alpha.Raw_context.context ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Tezos_raw_protocol_alpha.Tez_repr.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.context) := Raw_context.add_deposit.

Definition add_fees
  : Tezos_raw_protocol_alpha.Raw_context.context ->
  Tezos_raw_protocol_alpha.Tez_repr.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.context) := Raw_context.add_fees.

Definition add_rewards
  : Tezos_raw_protocol_alpha.Raw_context.context ->
  Tezos_raw_protocol_alpha.Tez_repr.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.context) := Raw_context.add_rewards.

Definition get_deposits
  : Tezos_raw_protocol_alpha.Raw_context.context ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.Map.t
    Tezos_raw_protocol_alpha.Tez_repr.t := Raw_context.get_deposits.

Definition get_fees
  : Tezos_raw_protocol_alpha.Raw_context.context ->
  Tezos_raw_protocol_alpha.Tez_repr.t := Raw_context.get_fees.

Definition get_rewards
  : Tezos_raw_protocol_alpha.Raw_context.context ->
  Tezos_raw_protocol_alpha.Tez_repr.t := Raw_context.get_rewards.

Definition description
  : Tezos_raw_protocol_alpha.Storage_description.t
    Tezos_raw_protocol_alpha.Raw_context.context := Raw_context.description.

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

module type BASIC_DATA = sig
  type t

  include Compare.S with type t := t

  val encoding : t Data_encoding.t

  val pp : Format.formatter -> t -> unit
end

type t

type context = t

type public_key = Signature.Public_key.t

type public_key_hash = Signature.Public_key_hash.t

type signature = Signature.t

module Tez : sig
  include BASIC_DATA

  type tez = t

  val zero : tez

  val one_mutez : tez

  val one_cent : tez

  val fifty_cents : tez

  val one : tez

  val ( -? ) : tez -> tez -> tez tzresult

  val ( +? ) : tez -> tez -> tez tzresult

  val ( *? ) : tez -> int64 -> tez tzresult

  val ( /? ) : tez -> int64 -> tez tzresult

  val of_string : string -> tez option

  val to_string : tez -> string

  val of_mutez : int64 -> tez option

  val to_mutez : tez -> int64
end

module Period : sig
  include BASIC_DATA

  type period = t

  val rpc_arg : period RPC_arg.arg

  val of_seconds : int64 -> period tzresult

  val to_seconds : period -> int64

  val mult : int32 -> period -> period tzresult

  val zero : period

  val one_second : period

  val one_minute : period

  val one_hour : period
end

module Timestamp : sig
  include BASIC_DATA with type t = Time.t

  type time = t

  val ( +? ) : time -> Period.t -> time tzresult

  val ( -? ) : time -> time -> Period.t tzresult

  val of_notation : string -> time option

  val to_notation : time -> string

  val of_seconds : string -> time option

  val to_seconds_string : time -> string

  val current : context -> time
end

module Raw_level : sig
  include BASIC_DATA

  type raw_level = t

  val rpc_arg : raw_level RPC_arg.arg

  val diff : raw_level -> raw_level -> int32

  val root : raw_level

  val succ : raw_level -> raw_level

  val pred : raw_level -> raw_level option

  val to_int32 : raw_level -> int32

  val of_int32 : int32 -> raw_level tzresult
end

module Cycle : sig
  include BASIC_DATA

  type cycle = t

  val rpc_arg : cycle RPC_arg.arg

  val root : cycle

  val succ : cycle -> cycle

  val pred : cycle -> cycle option

  val add : cycle -> int -> cycle

  val sub : cycle -> int -> cycle option

  val to_int32 : cycle -> int32

  module Map : S.MAP with type key = cycle
end

module Gas : sig
  type t = private Unaccounted | Limited of {remaining : Z.t}

  val encoding : t Data_encoding.encoding

  val pp : Format.formatter -> t -> unit

  type cost

  val cost_encoding : cost Data_encoding.encoding

  val pp_cost : Format.formatter -> cost -> unit

  type error += Block_quota_exceeded (* `Temporary *)

  type error += Operation_quota_exceeded (* `Temporary *)

  type error += Gas_limit_too_high (* `Permanent *)

  val free : cost

  val atomic_step_cost : int -> cost

  val step_cost : int -> cost

  val alloc_cost : int -> cost

  val alloc_bytes_cost : int -> cost

  val alloc_mbytes_cost : int -> cost

  val alloc_bits_cost : int -> cost

  val read_bytes_cost : Z.t -> cost

  val write_bytes_cost : Z.t -> cost

  val ( *@ ) : int -> cost -> cost

  val ( +@ ) : cost -> cost -> cost

  val check_limit : context -> Z.t -> unit tzresult

  val set_limit : context -> Z.t -> context

  val set_unlimited : context -> context

  val consume : context -> cost -> context tzresult

  val check_enough : context -> cost -> unit tzresult

  val level : context -> t

  val consumed : since:context -> until:context -> Z.t

  val block_level : context -> Z.t
end

module Script_int : module type of Script_int_repr

module Script_timestamp : sig
  open Script_int

  type t

  val compare : t -> t -> int

  val to_string : t -> string

  val to_notation : t -> string option

  val to_num_str : t -> string

  val of_string : string -> t option

  val diff : t -> t -> z num

  val add_delta : t -> z num -> t

  val sub_delta : t -> z num -> t

  val now : context -> t

  val to_zint : t -> Z.t

  val of_zint : Z.t -> t
end

module Script : sig
  type prim = Michelson_v1_primitives.prim =
    | K_parameter
    | K_storage
    | K_code
    | D_False
    | D_Elt
    | D_Left
    | D_None
    | D_Pair
    | D_Right
    | D_Some
    | D_True
    | D_Unit
    | I_PACK
    | I_UNPACK
    | I_BLAKE2B
    | I_SHA256
    | I_SHA512
    | I_ABS
    | I_ADD
    | I_AMOUNT
    | I_AND
    | I_BALANCE
    | I_CAR
    | I_CDR
    | I_CHAIN_ID
    | I_CHECK_SIGNATURE
    | I_COMPARE
    | I_CONCAT
    | I_CONS
    | I_CREATE_ACCOUNT
    | I_CREATE_CONTRACT
    | I_IMPLICIT_ACCOUNT
    | I_DIP
    | I_DROP
    | I_DUP
    | I_EDIV
    | I_EMPTY_BIG_MAP
    | I_EMPTY_MAP
    | I_EMPTY_SET
    | I_EQ
    | I_EXEC
    | I_APPLY
    | I_FAILWITH
    | I_GE
    | I_GET
    | I_GT
    | I_HASH_KEY
    | I_IF
    | I_IF_CONS
    | I_IF_LEFT
    | I_IF_NONE
    | I_INT
    | I_LAMBDA
    | I_LE
    | I_LEFT
    | I_LOOP
    | I_LSL
    | I_LSR
    | I_LT
    | I_MAP
    | I_MEM
    | I_MUL
    | I_NEG
    | I_NEQ
    | I_NIL
    | I_NONE
    | I_NOT
    | I_NOW
    | I_OR
    | I_PAIR
    | I_PUSH
    | I_RIGHT
    | I_SIZE
    | I_SOME
    | I_SOURCE
    | I_SENDER
    | I_SELF
    | I_SLICE
    | I_STEPS_TO_QUOTA
    | I_SUB
    | I_SWAP
    | I_TRANSFER_TOKENS
    | I_SET_DELEGATE
    | I_UNIT
    | I_UPDATE
    | I_XOR
    | I_ITER
    | I_LOOP_LEFT
    | I_ADDRESS
    | I_CONTRACT
    | I_ISNAT
    | I_CAST
    | I_RENAME
    | I_DIG
    | I_DUG
    | T_bool
    | T_contract
    | T_int
    | T_key
    | T_key_hash
    | T_lambda
    | T_list
    | T_map
    | T_big_map
    | T_nat
    | T_option
    | T_or
    | T_pair
    | T_set
    | T_signature
    | T_string
    | T_bytes
    | T_mutez
    | T_timestamp
    | T_unit
    | T_operation
    | T_address
    | T_chain_id

  type location = Micheline.canonical_location

  type annot = Micheline.annot

  type expr = prim Micheline.canonical

  type lazy_expr = expr Data_encoding.lazy_t

  val lazy_expr : expr -> lazy_expr

  type node = (location, prim) Micheline.node

  type t = {code : lazy_expr; storage : lazy_expr}

  val location_encoding : location Data_encoding.t

  val expr_encoding : expr Data_encoding.t

  val prim_encoding : prim Data_encoding.t

  val encoding : t Data_encoding.t

  val lazy_expr_encoding : lazy_expr Data_encoding.t

  val deserialized_cost : expr -> Gas.cost

  val serialized_cost : MBytes.t -> Gas.cost

  val traversal_cost : node -> Gas.cost

  val node_cost : node -> Gas.cost

  val int_node_cost : Z.t -> Gas.cost

  val int_node_cost_of_numbits : int -> Gas.cost

  val string_node_cost : string -> Gas.cost

  val string_node_cost_of_length : int -> Gas.cost

  val bytes_node_cost : MBytes.t -> Gas.cost

  val bytes_node_cost_of_length : int -> Gas.cost

  val prim_node_cost_nonrec : expr list -> annot -> Gas.cost

  val prim_node_cost_nonrec_of_length : int -> annot -> Gas.cost

  val seq_node_cost_nonrec : expr list -> Gas.cost

  val seq_node_cost_nonrec_of_length : int -> Gas.cost

  val minimal_deserialize_cost : lazy_expr -> Gas.cost

  val force_decode : context -> lazy_expr -> (expr * context) tzresult Lwt.t

  val force_bytes : context -> lazy_expr -> (MBytes.t * context) tzresult Lwt.t

  val unit_parameter : lazy_expr

  module Legacy_support : sig
    val manager_script_code : lazy_expr

    val add_do :
      manager_pkh:Signature.Public_key_hash.t ->
      script_code:lazy_expr ->
      script_storage:lazy_expr ->
      (lazy_expr * lazy_expr) tzresult Lwt.t

    val add_set_delegate :
      manager_pkh:Signature.Public_key_hash.t ->
      script_code:lazy_expr ->
      script_storage:lazy_expr ->
      (lazy_expr * lazy_expr) tzresult Lwt.t

    val has_default_entrypoint : lazy_expr -> bool

    val add_root_entrypoint : script_code:lazy_expr -> lazy_expr tzresult Lwt.t
  end
end

module Constants : sig
  (** Fixed constants *)
  type fixed = {
    proof_of_work_nonce_size : int;
    nonce_length : int;
    max_revelations_per_block : int;
    max_operation_data_length : int;
    max_proposals_per_delegate : int;
  }

  val fixed_encoding : fixed Data_encoding.t

  val fixed : fixed

  val proof_of_work_nonce_size : int

  val nonce_length : int

  val max_revelations_per_block : int

  val max_operation_data_length : int

  val max_proposals_per_delegate : int

  (** Constants parameterized by context *)
  type parametric = {
    preserved_cycles : int;
    blocks_per_cycle : int32;
    blocks_per_commitment : int32;
    blocks_per_roll_snapshot : int32;
    blocks_per_voting_period : int32;
    time_between_blocks : Period.t list;
    endorsers_per_block : int;
    hard_gas_limit_per_operation : Z.t;
    hard_gas_limit_per_block : Z.t;
    proof_of_work_threshold : int64;
    tokens_per_roll : Tez.t;
    michelson_maximum_type_size : int;
    seed_nonce_revelation_tip : Tez.t;
    origination_size : int;
    block_security_deposit : Tez.t;
    endorsement_security_deposit : Tez.t;
    block_reward : Tez.t;
    endorsement_reward : Tez.t;
    cost_per_byte : Tez.t;
    hard_storage_limit_per_operation : Z.t;
    test_chain_duration : int64;
    quorum_min : int32;
    quorum_max : int32;
    min_proposal_quorum : int32;
    initial_endorsers : int;
    delay_per_missing_endorsement : Period.t;
  }

  val parametric_encoding : parametric Data_encoding.t

  val parametric : context -> parametric

  val preserved_cycles : context -> int

  val blocks_per_cycle : context -> int32

  val blocks_per_commitment : context -> int32

  val blocks_per_roll_snapshot : context -> int32

  val blocks_per_voting_period : context -> int32

  val time_between_blocks : context -> Period.t list

  val endorsers_per_block : context -> int

  val initial_endorsers : context -> int

  val delay_per_missing_endorsement : context -> Period.t

  val hard_gas_limit_per_operation : context -> Z.t

  val hard_gas_limit_per_block : context -> Z.t

  val cost_per_byte : context -> Tez.t

  val hard_storage_limit_per_operation : context -> Z.t

  val proof_of_work_threshold : context -> int64

  val tokens_per_roll : context -> Tez.t

  val michelson_maximum_type_size : context -> int

  val block_reward : context -> Tez.t

  val endorsement_reward : context -> Tez.t

  val seed_nonce_revelation_tip : context -> Tez.t

  val origination_size : context -> int

  val block_security_deposit : context -> Tez.t

  val endorsement_security_deposit : context -> Tez.t

  val test_chain_duration : context -> int64

  val quorum_min : context -> int32

  val quorum_max : context -> int32

  val min_proposal_quorum : context -> int32

  (** All constants: fixed and parametric *)
  type t = {fixed : fixed; parametric : parametric}

  val encoding : t Data_encoding.t
end

module Voting_period : sig
  include BASIC_DATA

  type voting_period = t

  val rpc_arg : voting_period RPC_arg.arg

  val root : voting_period

  val succ : voting_period -> voting_period

  type kind = Proposal | Testing_vote | Testing | Promotion_vote

  val kind_encoding : kind Data_encoding.encoding

  val to_int32 : voting_period -> int32
end

module Level : sig
  type t = private {
    level : Raw_level.t;
    level_position : int32;
    cycle : Cycle.t;
    cycle_position : int32;
    voting_period : Voting_period.t;
    voting_period_position : int32;
    expected_commitment : bool;
  }

  include BASIC_DATA with type t := t

  val pp_full : Format.formatter -> t -> unit

  type level = t

  val root : context -> level

  val succ : context -> level -> level

  val pred : context -> level -> level option

  val from_raw : context -> ?offset:int32 -> Raw_level.t -> level

  val diff : level -> level -> int32

  val current : context -> level

  val last_level_in_cycle : context -> Cycle.t -> level

  val levels_in_cycle : context -> Cycle.t -> level list

  val levels_in_current_cycle : context -> ?offset:int32 -> unit -> level list

  val last_allowed_fork_level : context -> Raw_level.t
end

module Fitness : sig
  include module type of Fitness

  type fitness = t

  val increase : ?gap:int -> context -> context

  val current : context -> int64

  val to_int64 : fitness -> int64 tzresult
end

module Nonce : sig
  type t

  type nonce = t

  val encoding : nonce Data_encoding.t

  type unrevealed = {
    nonce_hash : Nonce_hash.t;
    delegate : public_key_hash;
    rewards : Tez.t;
    fees : Tez.t;
  }

  val record_hash : context -> unrevealed -> context tzresult Lwt.t

  val reveal : context -> Level.t -> nonce -> context tzresult Lwt.t

  type status = Unrevealed of unrevealed | Revealed of nonce

  val get : context -> Level.t -> status tzresult Lwt.t

  val of_bytes : MBytes.t -> nonce tzresult

  val hash : nonce -> Nonce_hash.t

  val check_hash : nonce -> Nonce_hash.t -> bool
end

module Seed : sig
  type seed

  type error +=
    | Unknown of {oldest : Cycle.t; cycle : Cycle.t; latest : Cycle.t}

  val for_cycle : context -> Cycle.t -> seed tzresult Lwt.t

  val cycle_end :
    context -> Cycle.t -> (context * Nonce.unrevealed list) tzresult Lwt.t

  val seed_encoding : seed Data_encoding.t
end

module Big_map : sig
  type id = Z.t

  val fresh : context -> (context * id) tzresult Lwt.t

  val fresh_temporary : context -> context * id

  val mem :
    context -> id -> Script_expr_hash.t -> (context * bool) tzresult Lwt.t

  val get_opt :
    context ->
    id ->
    Script_expr_hash.t ->
    (context * Script.expr option) tzresult Lwt.t

  val rpc_arg : id RPC_arg.t

  val cleanup_temporary : context -> context Lwt.t

  val exists :
    context ->
    id ->
    (context * (Script.expr * Script.expr) option) tzresult Lwt.t
end

module Contract : sig
  include BASIC_DATA

  type contract = t

  val rpc_arg : contract RPC_arg.arg

  val to_b58check : contract -> string

  val of_b58check : string -> contract tzresult

  val implicit_contract : public_key_hash -> contract

  val is_implicit : contract -> public_key_hash option

  val exists : context -> contract -> bool tzresult Lwt.t

  val must_exist : context -> contract -> unit tzresult Lwt.t

  val allocated : context -> contract -> bool tzresult Lwt.t

  val must_be_allocated : context -> contract -> unit tzresult Lwt.t

  val list : context -> contract list Lwt.t

  val get_manager_key : context -> public_key_hash -> public_key tzresult Lwt.t

  val is_manager_key_revealed :
    context -> public_key_hash -> bool tzresult Lwt.t

  val reveal_manager_key :
    context -> public_key_hash -> public_key -> context tzresult Lwt.t

  val get_script_code :
    context -> contract -> (context * Script.lazy_expr option) tzresult Lwt.t

  val get_script :
    context -> contract -> (context * Script.t option) tzresult Lwt.t

  val get_storage :
    context -> contract -> (context * Script.expr option) tzresult Lwt.t

  val get_counter : context -> public_key_hash -> Z.t tzresult Lwt.t

  val get_balance : context -> contract -> Tez.t tzresult Lwt.t

  val init_origination_nonce : context -> Operation_hash.t -> context

  val unset_origination_nonce : context -> context

  val fresh_contract_from_current_nonce :
    context -> (context * t) tzresult Lwt.t

  val originated_from_current_nonce :
    since:context -> until:context -> contract list tzresult Lwt.t

  type big_map_diff_item =
    | Update of {
        big_map : Big_map.id;
        diff_key : Script.expr;
        diff_key_hash : Script_expr_hash.t;
        diff_value : Script.expr option;
      }
    | Clear of Big_map.id
    | Copy of Big_map.id * Big_map.id
    | Alloc of {
        big_map : Big_map.id;
        key_type : Script.expr;
        value_type : Script.expr;
      }

  type big_map_diff = big_map_diff_item list

  val big_map_diff_encoding : big_map_diff Data_encoding.t

  val originate :
    context ->
    contract ->
    balance:Tez.t ->
    script:Script.t * big_map_diff option ->
    delegate:public_key_hash option ->
    context tzresult Lwt.t

  type error += Balance_too_low of contract * Tez.t * Tez.t

  val spend : context -> contract -> Tez.t -> context tzresult Lwt.t

  val credit : context -> contract -> Tez.t -> context tzresult Lwt.t

  val update_script_storage :
    context ->
    contract ->
    Script.expr ->
    big_map_diff option ->
    context tzresult Lwt.t

  val used_storage_space : context -> t -> Z.t tzresult Lwt.t

  val increment_counter : context -> public_key_hash -> context tzresult Lwt.t

  val check_counter_increment :
    context -> public_key_hash -> Z.t -> unit tzresult Lwt.t

  (**/**)

  (* Only for testing *)
  type origination_nonce

  val initial_origination_nonce : Operation_hash.t -> origination_nonce

  val originated_contract : origination_nonce -> contract
end

module Delegate : sig
  type balance =
    | Contract of Contract.t
    | Rewards of Signature.Public_key_hash.t * Cycle.t
    | Fees of Signature.Public_key_hash.t * Cycle.t
    | Deposits of Signature.Public_key_hash.t * Cycle.t

  type balance_update = Debited of Tez.t | Credited of Tez.t

  type balance_updates = (balance * balance_update) list

  val balance_updates_encoding : balance_updates Data_encoding.t

  val cleanup_balance_updates : balance_updates -> balance_updates

  val get : context -> Contract.t -> public_key_hash option tzresult Lwt.t

  val set :
    context -> Contract.t -> public_key_hash option -> context tzresult Lwt.t

  val fold :
    context -> init:'a -> f:(public_key_hash -> 'a -> 'a Lwt.t) -> 'a Lwt.t

  val list : context -> public_key_hash list Lwt.t

  val freeze_deposit :
    context -> public_key_hash -> Tez.t -> context tzresult Lwt.t

  val freeze_rewards :
    context -> public_key_hash -> Tez.t -> context tzresult Lwt.t

  val freeze_fees :
    context -> public_key_hash -> Tez.t -> context tzresult Lwt.t

  val cycle_end :
    context ->
    Cycle.t ->
    Nonce.unrevealed list ->
    (context * balance_updates * Signature.Public_key_hash.t list) tzresult
    Lwt.t

  type frozen_balance = {deposit : Tez.t; fees : Tez.t; rewards : Tez.t}

  val punish :
    context ->
    public_key_hash ->
    Cycle.t ->
    (context * frozen_balance) tzresult Lwt.t

  val full_balance : context -> public_key_hash -> Tez.t tzresult Lwt.t

  val has_frozen_balance :
    context -> public_key_hash -> Cycle.t -> bool tzresult Lwt.t

  val frozen_balance : context -> public_key_hash -> Tez.t tzresult Lwt.t

  val frozen_balance_encoding : frozen_balance Data_encoding.t

  val frozen_balance_by_cycle_encoding :
    frozen_balance Cycle.Map.t Data_encoding.t

  val frozen_balance_by_cycle :
    context -> Signature.Public_key_hash.t -> frozen_balance Cycle.Map.t Lwt.t

  val staking_balance :
    context -> Signature.Public_key_hash.t -> Tez.t tzresult Lwt.t

  val delegated_contracts :
    context -> Signature.Public_key_hash.t -> Contract_repr.t list Lwt.t

  val delegated_balance :
    context -> Signature.Public_key_hash.t -> Tez.t tzresult Lwt.t

  val deactivated :
    context -> Signature.Public_key_hash.t -> bool tzresult Lwt.t

  val grace_period :
    context -> Signature.Public_key_hash.t -> Cycle.t tzresult Lwt.t
end

module Vote : sig
  type proposal = Protocol_hash.t

  val record_proposal :
    context -> Protocol_hash.t -> public_key_hash -> context tzresult Lwt.t

  val get_proposals : context -> int32 Protocol_hash.Map.t tzresult Lwt.t

  val clear_proposals : context -> context Lwt.t

  val recorded_proposal_count_for_delegate :
    context -> public_key_hash -> int tzresult Lwt.t

  val listings_encoding :
    (Signature.Public_key_hash.t * int32) list Data_encoding.t

  val freeze_listings : context -> context tzresult Lwt.t

  val clear_listings : context -> context tzresult Lwt.t

  val listing_size : context -> int32 tzresult Lwt.t

  val in_listings : context -> public_key_hash -> bool Lwt.t

  val get_listings : context -> (public_key_hash * int32) list Lwt.t

  type ballot = Yay | Nay | Pass

  val ballot_encoding : ballot Data_encoding.t

  type ballots = {yay : int32; nay : int32; pass : int32}

  val ballots_encoding : ballots Data_encoding.t

  val has_recorded_ballot : context -> public_key_hash -> bool Lwt.t

  val record_ballot :
    context -> public_key_hash -> ballot -> context tzresult Lwt.t

  val get_ballots : context -> ballots tzresult Lwt.t

  val get_ballot_list :
    context -> (Signature.Public_key_hash.t * ballot) list Lwt.t

  val clear_ballots : context -> context Lwt.t

  val get_current_period_kind : context -> Voting_period.kind tzresult Lwt.t

  val set_current_period_kind :
    context -> Voting_period.kind -> context tzresult Lwt.t

  val get_current_quorum : context -> int32 tzresult Lwt.t

  val get_participation_ema : context -> int32 tzresult Lwt.t

  val set_participation_ema : context -> int32 -> context tzresult Lwt.t

  val get_current_proposal : context -> proposal tzresult Lwt.t

  val init_current_proposal : context -> proposal -> context tzresult Lwt.t

  val clear_current_proposal : context -> context tzresult Lwt.t
end

module Block_header : sig
  type t = {shell : Block_header.shell_header; protocol_data : protocol_data}

  and protocol_data = {contents : contents; signature : Signature.t}

  and contents = {
    priority : int;
    seed_nonce_hash : Nonce_hash.t option;
    proof_of_work_nonce : MBytes.t;
  }

  type block_header = t

  type raw = Block_header.t

  type shell_header = Block_header.shell_header

  val raw : block_header -> raw

  val hash : block_header -> Block_hash.t

  val hash_raw : raw -> Block_hash.t

  val encoding : block_header Data_encoding.encoding

  val raw_encoding : raw Data_encoding.t

  val contents_encoding : contents Data_encoding.t

  val unsigned_encoding : (shell_header * contents) Data_encoding.t

  val protocol_data_encoding : protocol_data Data_encoding.encoding

  val shell_header_encoding : shell_header Data_encoding.encoding

  (** The maximum size of block headers in bytes *)
  val max_header_length : int
end

module Kind : sig
  type seed_nonce_revelation = Seed_nonce_revelation_kind

  type double_endorsement_evidence = Double_endorsement_evidence_kind

  type double_baking_evidence = Double_baking_evidence_kind

  type activate_account = Activate_account_kind

  type endorsement = Endorsement_kind

  type proposals = Proposals_kind

  type ballot = Ballot_kind

  type reveal = Reveal_kind

  type transaction = Transaction_kind

  type origination = Origination_kind

  type delegation = Delegation_kind

  type 'a manager =
    | Reveal_manager_kind : reveal manager
    | Transaction_manager_kind : transaction manager
    | Origination_manager_kind : origination manager
    | Delegation_manager_kind : delegation manager
end

type 'kind operation = {
  shell : Operation.shell_header;
  protocol_data : 'kind protocol_data;
}

and 'kind protocol_data = {
  contents : 'kind contents_list;
  signature : Signature.t option;
}

and _ contents_list =
  | Single : 'kind contents -> 'kind contents_list
  | Cons :
      'kind Kind.manager contents * 'rest Kind.manager contents_list
      -> ('kind * 'rest) Kind.manager contents_list

and _ contents =
  | Endorsement : {level : Raw_level.t} -> Kind.endorsement contents
  | Seed_nonce_revelation : {
      level : Raw_level.t;
      nonce : Nonce.t;
    }
      -> Kind.seed_nonce_revelation contents
  | Double_endorsement_evidence : {
      op1 : Kind.endorsement operation;
      op2 : Kind.endorsement operation;
    }
      -> Kind.double_endorsement_evidence contents
  | Double_baking_evidence : {
      bh1 : Block_header.t;
      bh2 : Block_header.t;
    }
      -> Kind.double_baking_evidence contents
  | Activate_account : {
      id : Ed25519.Public_key_hash.t;
      activation_code : Blinded_public_key_hash.activation_code;
    }
      -> Kind.activate_account contents
  | Proposals : {
      source : Signature.Public_key_hash.t;
      period : Voting_period.t;
      proposals : Protocol_hash.t list;
    }
      -> Kind.proposals contents
  | Ballot : {
      source : Signature.Public_key_hash.t;
      period : Voting_period.t;
      proposal : Protocol_hash.t;
      ballot : Vote.ballot;
    }
      -> Kind.ballot contents
  | Manager_operation : {
      source : Signature.Public_key_hash.t;
      fee : Tez.tez;
      counter : counter;
      operation : 'kind manager_operation;
      gas_limit : Z.t;
      storage_limit : Z.t;
    }
      -> 'kind Kind.manager contents

and _ manager_operation =
  | Reveal : Signature.Public_key.t -> Kind.reveal manager_operation
  | Transaction : {
      amount : Tez.tez;
      parameters : Script.lazy_expr;
      entrypoint : string;
      destination : Contract.contract;
    }
      -> Kind.transaction manager_operation
  | Origination : {
      delegate : Signature.Public_key_hash.t option;
      script : Script.t;
      credit : Tez.tez;
      preorigination : Contract.t option;
    }
      -> Kind.origination manager_operation
  | Delegation :
      Signature.Public_key_hash.t option
      -> Kind.delegation manager_operation

and counter = Z.t

type 'kind internal_operation = {
  source : Contract.contract;
  operation : 'kind manager_operation;
  nonce : int;
}

type packed_manager_operation =
  | Manager : 'kind manager_operation -> packed_manager_operation

type packed_contents = Contents : 'kind contents -> packed_contents

type packed_contents_list =
  | Contents_list : 'kind contents_list -> packed_contents_list

type packed_protocol_data =
  | Operation_data : 'kind protocol_data -> packed_protocol_data

type packed_operation = {
  shell : Operation.shell_header;
  protocol_data : packed_protocol_data;
}

type packed_internal_operation =
  | Internal_operation : 'kind internal_operation -> packed_internal_operation

val manager_kind : 'kind manager_operation -> 'kind Kind.manager

module Fees : sig
  val origination_burn : context -> (context * Tez.t) tzresult Lwt.t

  val record_paid_storage_space :
    context -> Contract.t -> (context * Z.t * Z.t * Tez.t) tzresult Lwt.t

  val start_counting_storage_fees : context -> context

  val burn_storage_fees :
    context -> storage_limit:Z.t -> payer:Contract.t -> context tzresult Lwt.t

  type error += Cannot_pay_storage_fee (* `Temporary *)

  type error += Operation_quota_exceeded (* `Temporary *)

  type error += Storage_limit_too_high (* `Permanent *)

  val check_storage_limit : context -> storage_limit:Z.t -> unit tzresult
end

module Operation : sig
  type nonrec 'kind contents = 'kind contents

  type nonrec packed_contents = packed_contents

  val contents_encoding : packed_contents Data_encoding.t

  type nonrec 'kind protocol_data = 'kind protocol_data

  type nonrec packed_protocol_data = packed_protocol_data

  val protocol_data_encoding : packed_protocol_data Data_encoding.t

  val unsigned_encoding :
    (Operation.shell_header * packed_contents_list) Data_encoding.t

  type raw = Operation.t = {shell : Operation.shell_header; proto : MBytes.t}

  val raw_encoding : raw Data_encoding.t

  val contents_list_encoding : packed_contents_list Data_encoding.t

  type 'kind t = 'kind operation = {
    shell : Operation.shell_header;
    protocol_data : 'kind protocol_data;
  }

  type nonrec packed = packed_operation

  val encoding : packed Data_encoding.t

  val raw : _ operation -> raw

  val hash : _ operation -> Operation_hash.t

  val hash_raw : raw -> Operation_hash.t

  val hash_packed : packed_operation -> Operation_hash.t

  val acceptable_passes : packed_operation -> int list

  type error += Missing_signature (* `Permanent *)

  type error += Invalid_signature (* `Permanent *)

  val check_signature :
    public_key -> Chain_id.t -> _ operation -> unit tzresult Lwt.t

  val check_signature_sync :
    public_key -> Chain_id.t -> _ operation -> unit tzresult

  val internal_operation_encoding : packed_internal_operation Data_encoding.t

  val pack : 'kind operation -> packed_operation

  type ('a, 'b) eq = Eq : ('a, 'a) eq

  val equal : 'a operation -> 'b operation -> ('a, 'b) eq option

  module Encoding : sig
    type 'b case =
      | Case : {
          tag : int;
          name : string;
          encoding : 'a Data_encoding.t;
          select : packed_contents -> 'b contents option;
          proj : 'b contents -> 'a;
          inj : 'a -> 'b contents;
        }
          -> 'b case

    val endorsement_case : Kind.endorsement case

    val seed_nonce_revelation_case : Kind.seed_nonce_revelation case

    val double_endorsement_evidence_case :
      Kind.double_endorsement_evidence case

    val double_baking_evidence_case : Kind.double_baking_evidence case

    val activate_account_case : Kind.activate_account case

    val proposals_case : Kind.proposals case

    val ballot_case : Kind.ballot case

    val reveal_case : Kind.reveal Kind.manager case

    val transaction_case : Kind.transaction Kind.manager case

    val origination_case : Kind.origination Kind.manager case

    val delegation_case : Kind.delegation Kind.manager case

    module Manager_operations : sig
      type 'b case =
        | MCase : {
            tag : int;
            name : string;
            encoding : 'a Data_encoding.t;
            select :
              packed_manager_operation -> 'kind manager_operation option;
            proj : 'kind manager_operation -> 'a;
            inj : 'a -> 'kind manager_operation;
          }
            -> 'kind case

      val reveal_case : Kind.reveal case

      val transaction_case : Kind.transaction case

      val origination_case : Kind.origination case

      val delegation_case : Kind.delegation case
    end
  end

  val of_list : packed_contents list -> packed_contents_list

  val to_list : packed_contents_list -> packed_contents list
end

module Roll : sig
  type t = private int32

  type roll = t

  val encoding : roll Data_encoding.t

  val snapshot_rolls : context -> context tzresult Lwt.t

  val cycle_end : context -> Cycle.t -> context tzresult Lwt.t

  val baking_rights_owner :
    context -> Level.t -> priority:int -> public_key tzresult Lwt.t

  val endorsement_rights_owner :
    context -> Level.t -> slot:int -> public_key tzresult Lwt.t

  val delegate_pubkey : context -> public_key_hash -> public_key tzresult Lwt.t

  val get_rolls :
    context -> Signature.Public_key_hash.t -> roll list tzresult Lwt.t

  val get_change :
    context -> Signature.Public_key_hash.t -> Tez.t tzresult Lwt.t
end

module Commitment : sig
  type t = {
    blinded_public_key_hash : Blinded_public_key_hash.t;
    amount : Tez.tez;
  }

  val get_opt :
    context -> Blinded_public_key_hash.t -> Tez.t option tzresult Lwt.t

  val delete : context -> Blinded_public_key_hash.t -> context tzresult Lwt.t
end

module Bootstrap : sig
  val cycle_end : context -> Cycle.t -> context tzresult Lwt.t
end

module Global : sig
  val get_block_priority : context -> int tzresult Lwt.t

  val set_block_priority : context -> int -> context tzresult Lwt.t
end

val prepare_first_block :
  Context.t ->
  typecheck:(context ->
            Script.t ->
            ((Script.t * Contract.big_map_diff option) * context) tzresult
            Lwt.t) ->
  level:Int32.t ->
  timestamp:Time.t ->
  fitness:Fitness.t ->
  context tzresult Lwt.t

val prepare :
  Context.t ->
  level:Int32.t ->
  predecessor_timestamp:Time.t ->
  timestamp:Time.t ->
  fitness:Fitness.t ->
  context tzresult Lwt.t

val finalize : ?commit_message:string -> context -> Updater.validation_result

val activate : context -> Protocol_hash.t -> context Lwt.t

val fork_test_chain : context -> Protocol_hash.t -> Time.t -> context Lwt.t

val record_endorsement : context -> Signature.Public_key_hash.t -> context

val allowed_endorsements :
  context ->
  (Signature.Public_key.t * int list * bool) Signature.Public_key_hash.Map.t

val init_endorsements :
  context ->
  (Signature.Public_key.t * int list * bool) Signature.Public_key_hash.Map.t ->
  context

val included_endorsements : context -> int

val reset_internal_nonce : context -> context

val fresh_internal_nonce : context -> (context * int) tzresult

val record_internal_nonce : context -> int -> context

val internal_nonce_already_recorded : context -> int -> bool

val add_fees : context -> Tez.t -> context tzresult Lwt.t

val add_rewards : context -> Tez.t -> context tzresult Lwt.t

val add_deposit :
  context -> Signature.Public_key_hash.t -> Tez.t -> context tzresult Lwt.t

val get_fees : context -> Tez.t

val get_rewards : context -> Tez.t

val get_deposits : context -> Tez.t Signature.Public_key_hash.Map.t

val description : context Storage_description.t

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Module BASIC_DATA.
  Record signature {t : Set} := {
    t := t;
    op_eq : t -> t -> bool;
    op_ltgt : t -> t -> bool;
    op_lt : t -> t -> bool;
    op_lteq : t -> t -> bool;
    op_gteq : t -> t -> bool;
    op_gt : t -> t -> bool;
    compare : t -> t -> Z;
    equal : t -> t -> bool;
    max : t -> t -> t;
    min : t -> t -> t;
    encoding : Tezos_protocol_environment_alpha__Environment.Data_encoding.t t;
    pp :
      Tezos_protocol_environment_alpha__Environment.Format.formatter -> t ->
      unit;
  }.
  Arguments signature : clear implicits.
End BASIC_DATA.

Parameter t : Set.

Definition context := t.

Definition public_key :=
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t.

Definition public_key_hash :=
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t.

Definition signature :=
  Tezos_protocol_environment_alpha__Environment.Signature.t.

Module Tez.
  Parameter t : Set.
  
  Parameter op_eq : t -> t -> bool.
  
  Parameter op_ltgt : t -> t -> bool.
  
  Parameter op_lt : t -> t -> bool.
  
  Parameter op_lteq : t -> t -> bool.
  
  Parameter op_gteq : t -> t -> bool.
  
  Parameter op_gt : t -> t -> bool.
  
  Parameter compare : t -> t -> Z.
  
  Parameter equal : t -> t -> bool.
  
  Parameter max : t -> t -> t.
  
  Parameter min : t -> t -> t.
  
  Parameter encoding :
    Tezos_protocol_environment_alpha__Environment.Data_encoding.t t.
  
  Parameter pp :
    Tezos_protocol_environment_alpha__Environment.Format.formatter -> t -> unit.
  
  Definition tez := t.
  
  Parameter zero : tez.
  
  Parameter one_mutez : tez.
  
  Parameter one_cent : tez.
  
  Parameter fifty_cents : tez.
  
  Parameter one : tez.
  
  Parameter op_minusquestion :
    tez -> tez ->
    Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult tez.
  
  Parameter op_plusquestion :
    tez -> tez ->
    Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult tez.
  
  Parameter op_starquestion :
    tez -> int64 ->
    Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult tez.
  
  Parameter op_divquestion :
    tez -> int64 ->
    Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult tez.
  
  Parameter of_string : string -> option tez.
  
  Parameter to_string : tez -> string.
  
  Parameter of_mutez : int64 -> option tez.
  
  Parameter to_mutez : tez -> int64.
End Tez.

Module Period.
  Parameter t : Set.
  
  Parameter op_eq : t -> t -> bool.
  
  Parameter op_ltgt : t -> t -> bool.
  
  Parameter op_lt : t -> t -> bool.
  
  Parameter op_lteq : t -> t -> bool.
  
  Parameter op_gteq : t -> t -> bool.
  
  Parameter op_gt : t -> t -> bool.
  
  Parameter compare : t -> t -> Z.
  
  Parameter equal : t -> t -> bool.
  
  Parameter max : t -> t -> t.
  
  Parameter min : t -> t -> t.
  
  Parameter encoding :
    Tezos_protocol_environment_alpha__Environment.Data_encoding.t t.
  
  Parameter pp :
    Tezos_protocol_environment_alpha__Environment.Format.formatter -> t -> unit.
  
  Definition period := t.
  
  Parameter rpc_arg :
    Tezos_protocol_environment_alpha__Environment.RPC_arg.arg period.
  
  Parameter of_seconds :
    int64 ->
    Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult period.
  
  Parameter to_seconds : period -> int64.
  
  Parameter mult :
    int32 -> period ->
    Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult period.
  
  Parameter zero : period.
  
  Parameter one_second : period.
  
  Parameter one_minute : period.
  
  Parameter one_hour : period.
End Period.

Module Timestamp.
  Definition t := Tezos_protocol_environment_alpha__Environment.Time.t.
  
  Parameter op_eq : t -> t -> bool.
  
  Parameter op_ltgt : t -> t -> bool.
  
  Parameter op_lt : t -> t -> bool.
  
  Parameter op_lteq : t -> t -> bool.
  
  Parameter op_gteq : t -> t -> bool.
  
  Parameter op_gt : t -> t -> bool.
  
  Parameter compare : t -> t -> Z.
  
  Parameter equal : t -> t -> bool.
  
  Parameter max : t -> t -> t.
  
  Parameter min : t -> t -> t.
  
  Parameter encoding :
    Tezos_protocol_environment_alpha__Environment.Data_encoding.t t.
  
  Parameter pp :
    Tezos_protocol_environment_alpha__Environment.Format.formatter -> t -> unit.
  
  Definition time := t.
  
  Parameter op_plusquestion :
    time -> Period.t ->
    Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult time.
  
  Parameter op_minusquestion :
    time -> time ->
    Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult Period.t.
  
  Parameter of_notation : string -> option time.
  
  Parameter to_notation : time -> string.
  
  Parameter of_seconds : string -> option time.
  
  Parameter to_seconds_string : time -> string.
  
  Parameter current : context -> time.
End Timestamp.

Module Raw_level.
  Parameter t : Set.
  
  Parameter op_eq : t -> t -> bool.
  
  Parameter op_ltgt : t -> t -> bool.
  
  Parameter op_lt : t -> t -> bool.
  
  Parameter op_lteq : t -> t -> bool.
  
  Parameter op_gteq : t -> t -> bool.
  
  Parameter op_gt : t -> t -> bool.
  
  Parameter compare : t -> t -> Z.
  
  Parameter equal : t -> t -> bool.
  
  Parameter max : t -> t -> t.
  
  Parameter min : t -> t -> t.
  
  Parameter encoding :
    Tezos_protocol_environment_alpha__Environment.Data_encoding.t t.
  
  Parameter pp :
    Tezos_protocol_environment_alpha__Environment.Format.formatter -> t -> unit.
  
  Definition raw_level := t.
  
  Parameter rpc_arg :
    Tezos_protocol_environment_alpha__Environment.RPC_arg.arg raw_level.
  
  Parameter diff : raw_level -> raw_level -> int32.
  
  Parameter root : raw_level.
  
  Parameter succ : raw_level -> raw_level.
  
  Parameter pred : raw_level -> option raw_level.
  
  Parameter to_int32 : raw_level -> int32.
  
  Parameter of_int32 :
    int32 ->
    Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult raw_level.
End Raw_level.

Module Cycle.
  Parameter t : Set.
  
  Parameter op_eq : t -> t -> bool.
  
  Parameter op_ltgt : t -> t -> bool.
  
  Parameter op_lt : t -> t -> bool.
  
  Parameter op_lteq : t -> t -> bool.
  
  Parameter op_gteq : t -> t -> bool.
  
  Parameter op_gt : t -> t -> bool.
  
  Parameter compare : t -> t -> Z.
  
  Parameter equal : t -> t -> bool.
  
  Parameter max : t -> t -> t.
  
  Parameter min : t -> t -> t.
  
  Parameter encoding :
    Tezos_protocol_environment_alpha__Environment.Data_encoding.t t.
  
  Parameter pp :
    Tezos_protocol_environment_alpha__Environment.Format.formatter -> t -> unit.
  
  Definition cycle := t.
  
  Parameter rpc_arg :
    Tezos_protocol_environment_alpha__Environment.RPC_arg.arg cycle.
  
  Parameter root : cycle.
  
  Parameter succ : cycle -> cycle.
  
  Parameter pred : cycle -> option cycle.
  
  Parameter add : cycle -> Z -> cycle.
  
  Parameter sub : cycle -> Z -> option cycle.
  
  Parameter to_int32 : cycle -> int32.
  
  Module Map.
    Definition key := cycle.
    
    Parameter t : forall (a : Set), Set.
    
    Parameter empty : forall {a : Set}, t a.
    
    Parameter is_empty : forall {a : Set}, t a -> bool.
    
    Parameter mem : forall {a : Set}, key -> t a -> bool.
    
    Parameter add : forall {a : Set}, key -> a -> t a -> t a.
    
    Parameter update : forall {a : Set},
      key -> (option a -> option a) -> t a -> t a.
    
    Parameter singleton : forall {a : Set}, key -> a -> t a.
    
    Parameter remove : forall {a : Set}, key -> t a -> t a.
    
    Parameter merge : forall {a b c : Set},
      (key -> option a -> option b -> option c) -> t a -> t b -> t c.
    
    Parameter union : forall {a : Set},
      (key -> a -> a -> option a) -> t a -> t a -> t a.
    
    Parameter compare : forall {a : Set}, (a -> a -> Z) -> t a -> t a -> Z.
    
    Parameter equal : forall {a : Set}, (a -> a -> bool) -> t a -> t a -> bool.
    
    Parameter iter : forall {a : Set}, (key -> a -> unit) -> t a -> unit.
    
    Parameter fold : forall {a b : Set}, (key -> a -> b -> b) -> t a -> b -> b.
    
    Parameter for_all : forall {a : Set}, (key -> a -> bool) -> t a -> bool.
    
    Parameter __exists : forall {a : Set}, (key -> a -> bool) -> t a -> bool.
    
    Parameter filter : forall {a : Set}, (key -> a -> bool) -> t a -> t a.
    
    Parameter partition : forall {a : Set},
      (key -> a -> bool) -> t a -> t a * t a.
    
    Parameter cardinal : forall {a : Set}, t a -> Z.
    
    Parameter bindings : forall {a : Set}, t a -> list (key * a).
    
    Parameter min_binding_opt : forall {a : Set}, t a -> option (key * a).
    
    Parameter max_binding_opt : forall {a : Set}, t a -> option (key * a).
    
    Parameter choose_opt : forall {a : Set}, t a -> option (key * a).
    
    Parameter split : forall {a : Set}, key -> t a -> t a * option a * t a.
    
    Parameter find_opt : forall {a : Set}, key -> t a -> option a.
    
    Parameter find_first_opt : forall {a : Set},
      (key -> bool) -> t a -> option (key * a).
    
    Parameter find_last_opt : forall {a : Set},
      (key -> bool) -> t a -> option (key * a).
    
    Parameter map : forall {a b : Set}, (a -> b) -> t a -> t b.
    
    Parameter mapi : forall {a b : Set}, (key -> a -> b) -> t a -> t b.
  End Map.
End Cycle.

Module Gas.
  Inductive t : Set :=
  | Unaccounted : t
  | Limited : Tezos_protocol_environment_alpha__Environment.Z.t -> t.
  
  Parameter encoding :
    Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding t.
  
  Parameter pp :
    Tezos_protocol_environment_alpha__Environment.Format.formatter -> t -> unit.
  
  Parameter cost : Set.
  
  Parameter cost_encoding :
    Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding cost.
  
  Parameter pp_cost :
    Tezos_protocol_environment_alpha__Environment.Format.formatter -> cost ->
    unit.
  
  (* extensible_type Tezos_protocol_environment_alpha__Environment.Error_monad.error *)
  
  (* extensible_type Tezos_protocol_environment_alpha__Environment.Error_monad.error *)
  
  (* extensible_type Tezos_protocol_environment_alpha__Environment.Error_monad.error *)
  
  Parameter free : cost.
  
  Parameter atomic_step_cost : Z -> cost.
  
  Parameter step_cost : Z -> cost.
  
  Parameter alloc_cost : Z -> cost.
  
  Parameter alloc_bytes_cost : Z -> cost.
  
  Parameter alloc_mbytes_cost : Z -> cost.
  
  Parameter alloc_bits_cost : Z -> cost.
  
  Parameter read_bytes_cost :
    Tezos_protocol_environment_alpha__Environment.Z.t -> cost.
  
  Parameter write_bytes_cost :
    Tezos_protocol_environment_alpha__Environment.Z.t -> cost.
  
  Parameter op_starat : Z -> cost -> cost.
  
  Parameter op_plusat : cost -> cost -> cost.
  
  Parameter check_limit :
    context -> Tezos_protocol_environment_alpha__Environment.Z.t ->
    Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit.
  
  Parameter set_limit :
    context -> Tezos_protocol_environment_alpha__Environment.Z.t -> context.
  
  Parameter set_unlimited : context -> context.
  
  Parameter consume :
    context -> cost ->
    Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult context.
  
  Parameter check_enough :
    context -> cost ->
    Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit.
  
  Parameter level : context -> t.
  
  Parameter consumed :
    context -> context -> Tezos_protocol_environment_alpha__Environment.Z.t.
  
  Parameter block_level :
    context -> Tezos_protocol_environment_alpha__Environment.Z.t.
End Gas.

Module Script_int.
  Definition num (t : Set) := Tezos_raw_protocol_alpha__Script_int_repr.num t.
  
  Definition n := Tezos_raw_protocol_alpha__Script_int_repr.n.
  
  Definition z := Tezos_raw_protocol_alpha__Script_int_repr.z.
  
  Parameter zero_n : num n.
  
  Parameter zero : num z.
  
  Parameter compare : forall {a : Set}, num a -> num a -> Z.
  
  Parameter to_string : forall {A : Set}, num A -> string.
  
  Parameter of_string : string -> option (num z).
  
  Parameter to_int64 : forall {A : Set}, num A -> option int64.
  
  Parameter of_int64 : int64 -> num z.
  
  Parameter to_int : forall {A : Set}, num A -> option Z.
  
  Parameter of_int : Z -> num z.
  
  Parameter of_zint :
    Tezos_protocol_environment_alpha__Environment.Z.t -> num z.
  
  Parameter to_zint : forall {a : Set},
    num a -> Tezos_protocol_environment_alpha__Environment.Z.t.
  
  Parameter add_n : num n -> num n -> num n.
  
  Parameter mul_n : num n -> num n -> num n.
  
  Parameter ediv_n : num n -> num n -> option (num n * num n).
  
  Parameter add : forall {A B : Set}, num A -> num B -> num z.
  
  Parameter sub : forall {A B : Set}, num A -> num B -> num z.
  
  Parameter mul : forall {A B : Set}, num A -> num B -> num z.
  
  Parameter ediv : forall {A B : Set}, num A -> num B -> option (num z * num n).
  
  Parameter abs : num z -> num n.
  
  Parameter is_nat : num z -> option (num n).
  
  Parameter neg : forall {A : Set}, num A -> num z.
  
  Parameter int : num n -> num z.
  
  Parameter lognot : forall {A : Set}, num A -> num z.
  
  Parameter shift_left_n : num n -> num n -> option (num n).
  
  Parameter shift_right_n : num n -> num n -> option (num n).
  
  Parameter shift_left : forall {a : Set}, num a -> num n -> option (num a).
  
  Parameter shift_right : forall {a : Set}, num a -> num n -> option (num a).
  
  Parameter logor : forall {a : Set}, num a -> num a -> num a.
  
  Parameter logand : forall {A : Set}, num A -> num n -> num n.
  
  Parameter logxor : num n -> num n -> num n.
End Script_int.

Module Script_timestamp.
  Parameter t : Set.
  
  Parameter compare : t -> t -> Z.
  
  Parameter to_string : t -> string.
  
  Parameter to_notation : t -> option string.
  
  Parameter to_num_str : t -> string.
  
  Parameter of_string : string -> option t.
  
  Parameter diff : t -> t -> Script_int.num Script_int.z.
  
  Parameter add_delta : t -> Script_int.num Script_int.z -> t.
  
  Parameter sub_delta : t -> Script_int.num Script_int.z -> t.
  
  Parameter now : context -> t.
  
  Parameter to_zint : t -> Tezos_protocol_environment_alpha__Environment.Z.t.
  
  Parameter of_zint : Tezos_protocol_environment_alpha__Environment.Z.t -> t.
End Script_timestamp.

Module Script.
  Inductive prim : Set :=
  | K_parameter : prim
  | K_storage : prim
  | K_code : prim
  | D_False : prim
  | D_Elt : prim
  | D_Left : prim
  | D_None : prim
  | D_Pair : prim
  | D_Right : prim
  | D_Some : prim
  | D_True : prim
  | D_Unit : prim
  | I_PACK : prim
  | I_UNPACK : prim
  | I_BLAKE2B : prim
  | I_SHA256 : prim
  | I_SHA512 : prim
  | I_ABS : prim
  | I_ADD : prim
  | I_AMOUNT : prim
  | I_AND : prim
  | I_BALANCE : prim
  | I_CAR : prim
  | I_CDR : prim
  | I_CHAIN_ID : prim
  | I_CHECK_SIGNATURE : prim
  | I_COMPARE : prim
  | I_CONCAT : prim
  | I_CONS : prim
  | I_CREATE_ACCOUNT : prim
  | I_CREATE_CONTRACT : prim
  | I_IMPLICIT_ACCOUNT : prim
  | I_DIP : prim
  | I_DROP : prim
  | I_DUP : prim
  | I_EDIV : prim
  | I_EMPTY_BIG_MAP : prim
  | I_EMPTY_MAP : prim
  | I_EMPTY_SET : prim
  | I_EQ : prim
  | I_EXEC : prim
  | I_APPLY : prim
  | I_FAILWITH : prim
  | I_GE : prim
  | I_GET : prim
  | I_GT : prim
  | I_HASH_KEY : prim
  | I_IF : prim
  | I_IF_CONS : prim
  | I_IF_LEFT : prim
  | I_IF_NONE : prim
  | I_INT : prim
  | I_LAMBDA : prim
  | I_LE : prim
  | I_LEFT : prim
  | I_LOOP : prim
  | I_LSL : prim
  | I_LSR : prim
  | I_LT : prim
  | I_MAP : prim
  | I_MEM : prim
  | I_MUL : prim
  | I_NEG : prim
  | I_NEQ : prim
  | I_NIL : prim
  | I_NONE : prim
  | I_NOT : prim
  | I_NOW : prim
  | I_OR : prim
  | I_PAIR : prim
  | I_PUSH : prim
  | I_RIGHT : prim
  | I_SIZE : prim
  | I_SOME : prim
  | I_SOURCE : prim
  | I_SENDER : prim
  | I_SELF : prim
  | I_SLICE : prim
  | I_STEPS_TO_QUOTA : prim
  | I_SUB : prim
  | I_SWAP : prim
  | I_TRANSFER_TOKENS : prim
  | I_SET_DELEGATE : prim
  | I_UNIT : prim
  | I_UPDATE : prim
  | I_XOR : prim
  | I_ITER : prim
  | I_LOOP_LEFT : prim
  | I_ADDRESS : prim
  | I_CONTRACT : prim
  | I_ISNAT : prim
  | I_CAST : prim
  | I_RENAME : prim
  | I_DIG : prim
  | I_DUG : prim
  | T_bool : prim
  | T_contract : prim
  | T_int : prim
  | T_key : prim
  | T_key_hash : prim
  | T_lambda : prim
  | T_list : prim
  | T_map : prim
  | T_big_map : prim
  | T_nat : prim
  | T_option : prim
  | T_or : prim
  | T_pair : prim
  | T_set : prim
  | T_signature : prim
  | T_string : prim
  | T_bytes : prim
  | T_mutez : prim
  | T_timestamp : prim
  | T_unit : prim
  | T_operation : prim
  | T_address : prim
  | T_chain_id : prim.
  
  Definition location :=
    Tezos_protocol_environment_alpha__Environment.Micheline.canonical_location.
  
  Definition annot :=
    Tezos_protocol_environment_alpha__Environment.Micheline.annot.
  
  Definition expr :=
    Tezos_protocol_environment_alpha__Environment.Micheline.canonical prim.
  
  Definition lazy_expr :=
    Tezos_protocol_environment_alpha__Environment.Data_encoding.lazy_t expr.
  
  Parameter lazy_expr : expr -> lazy_expr.
  
  Definition node :=
    Tezos_protocol_environment_alpha__Environment.Micheline.node location prim.
  
  Module t.
    Record record := {
      code : lazy_expr;
      storage : lazy_expr }.
  End t.
  Definition t := t.record.
  
  Parameter location_encoding :
    Tezos_protocol_environment_alpha__Environment.Data_encoding.t location.
  
  Parameter expr_encoding :
    Tezos_protocol_environment_alpha__Environment.Data_encoding.t expr.
  
  Parameter prim_encoding :
    Tezos_protocol_environment_alpha__Environment.Data_encoding.t prim.
  
  Parameter encoding :
    Tezos_protocol_environment_alpha__Environment.Data_encoding.t t.
  
  Parameter lazy_expr_encoding :
    Tezos_protocol_environment_alpha__Environment.Data_encoding.t lazy_expr.
  
  Parameter deserialized_cost : expr -> Gas.cost.
  
  Parameter serialized_cost :
    Tezos_protocol_environment_alpha__Environment.MBytes.t -> Gas.cost.
  
  Parameter traversal_cost : node -> Gas.cost.
  
  Parameter node_cost : node -> Gas.cost.
  
  Parameter int_node_cost :
    Tezos_protocol_environment_alpha__Environment.Z.t -> Gas.cost.
  
  Parameter int_node_cost_of_numbits : Z -> Gas.cost.
  
  Parameter string_node_cost : string -> Gas.cost.
  
  Parameter string_node_cost_of_length : Z -> Gas.cost.
  
  Parameter bytes_node_cost :
    Tezos_protocol_environment_alpha__Environment.MBytes.t -> Gas.cost.
  
  Parameter bytes_node_cost_of_length : Z -> Gas.cost.
  
  Parameter prim_node_cost_nonrec : list expr -> annot -> Gas.cost.
  
  Parameter prim_node_cost_nonrec_of_length : Z -> annot -> Gas.cost.
  
  Parameter seq_node_cost_nonrec : list expr -> Gas.cost.
  
  Parameter seq_node_cost_nonrec_of_length : Z -> Gas.cost.
  
  Parameter minimal_deserialize_cost : lazy_expr -> Gas.cost.
  
  Parameter force_decode :
    context -> lazy_expr ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (expr * context)).
  
  Parameter force_bytes :
    context -> lazy_expr ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (Tezos_protocol_environment_alpha__Environment.MBytes.t * context)).
  
  Parameter unit_parameter : lazy_expr.
  
  Module Legacy_support.
    Parameter manager_script_code : lazy_expr.
    
    Parameter add_do :
      Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t
      -> lazy_expr -> lazy_expr ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (lazy_expr * lazy_expr)).
    
    Parameter add_set_delegate :
      Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t
      -> lazy_expr -> lazy_expr ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (lazy_expr * lazy_expr)).
    
    Parameter has_default_entrypoint : lazy_expr -> bool.
    
    Parameter add_root_entrypoint :
      lazy_expr ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          lazy_expr).
  End Legacy_support.
End Script.

Module Constants.
  Module fixed.
    Record record := {
      proof_of_work_nonce_size : Z;
      nonce_length : Z;
      max_revelations_per_block : Z;
      max_operation_data_length : Z;
      max_proposals_per_delegate : Z }.
  End fixed.
  Definition fixed := fixed.record.
  
  Parameter fixed_encoding :
    Tezos_protocol_environment_alpha__Environment.Data_encoding.t fixed.
  
  Parameter fixed : fixed.
  
  Parameter proof_of_work_nonce_size : Z.
  
  Parameter nonce_length : Z.
  
  Parameter max_revelations_per_block : Z.
  
  Parameter max_operation_data_length : Z.
  
  Parameter max_proposals_per_delegate : Z.
  
  Module parametric.
    Record record := {
      preserved_cycles : Z;
      blocks_per_cycle : int32;
      blocks_per_commitment : int32;
      blocks_per_roll_snapshot : int32;
      blocks_per_voting_period : int32;
      time_between_blocks : list Period.t;
      endorsers_per_block : Z;
      hard_gas_limit_per_operation :
        Tezos_protocol_environment_alpha__Environment.Z.t;
      hard_gas_limit_per_block :
        Tezos_protocol_environment_alpha__Environment.Z.t;
      proof_of_work_threshold : int64;
      tokens_per_roll : Tez.t;
      michelson_maximum_type_size : Z;
      seed_nonce_revelation_tip : Tez.t;
      origination_size : Z;
      block_security_deposit : Tez.t;
      endorsement_security_deposit : Tez.t;
      block_reward : Tez.t;
      endorsement_reward : Tez.t;
      cost_per_byte : Tez.t;
      hard_storage_limit_per_operation :
        Tezos_protocol_environment_alpha__Environment.Z.t;
      test_chain_duration : int64;
      quorum_min : int32;
      quorum_max : int32;
      min_proposal_quorum : int32;
      initial_endorsers : Z;
      delay_per_missing_endorsement : Period.t }.
  End parametric.
  Definition parametric := parametric.record.
  
  Parameter parametric_encoding :
    Tezos_protocol_environment_alpha__Environment.Data_encoding.t parametric.
  
  Parameter parametric : context -> parametric.
  
  Parameter preserved_cycles : context -> Z.
  
  Parameter blocks_per_cycle : context -> int32.
  
  Parameter blocks_per_commitment : context -> int32.
  
  Parameter blocks_per_roll_snapshot : context -> int32.
  
  Parameter blocks_per_voting_period : context -> int32.
  
  Parameter time_between_blocks : context -> list Period.t.
  
  Parameter endorsers_per_block : context -> Z.
  
  Parameter initial_endorsers : context -> Z.
  
  Parameter delay_per_missing_endorsement : context -> Period.t.
  
  Parameter hard_gas_limit_per_operation :
    context -> Tezos_protocol_environment_alpha__Environment.Z.t.
  
  Parameter hard_gas_limit_per_block :
    context -> Tezos_protocol_environment_alpha__Environment.Z.t.
  
  Parameter cost_per_byte : context -> Tez.t.
  
  Parameter hard_storage_limit_per_operation :
    context -> Tezos_protocol_environment_alpha__Environment.Z.t.
  
  Parameter proof_of_work_threshold : context -> int64.
  
  Parameter tokens_per_roll : context -> Tez.t.
  
  Parameter michelson_maximum_type_size : context -> Z.
  
  Parameter block_reward : context -> Tez.t.
  
  Parameter endorsement_reward : context -> Tez.t.
  
  Parameter seed_nonce_revelation_tip : context -> Tez.t.
  
  Parameter origination_size : context -> Z.
  
  Parameter block_security_deposit : context -> Tez.t.
  
  Parameter endorsement_security_deposit : context -> Tez.t.
  
  Parameter test_chain_duration : context -> int64.
  
  Parameter quorum_min : context -> int32.
  
  Parameter quorum_max : context -> int32.
  
  Parameter min_proposal_quorum : context -> int32.
  
  Module t.
    Record record := {
      fixed : fixed;
      parametric : parametric }.
  End t.
  Definition t := t.record.
  
  Parameter encoding :
    Tezos_protocol_environment_alpha__Environment.Data_encoding.t t.
End Constants.

Module Voting_period.
  Parameter t : Set.
  
  Parameter op_eq : t -> t -> bool.
  
  Parameter op_ltgt : t -> t -> bool.
  
  Parameter op_lt : t -> t -> bool.
  
  Parameter op_lteq : t -> t -> bool.
  
  Parameter op_gteq : t -> t -> bool.
  
  Parameter op_gt : t -> t -> bool.
  
  Parameter compare : t -> t -> Z.
  
  Parameter equal : t -> t -> bool.
  
  Parameter max : t -> t -> t.
  
  Parameter min : t -> t -> t.
  
  Parameter encoding :
    Tezos_protocol_environment_alpha__Environment.Data_encoding.t t.
  
  Parameter pp :
    Tezos_protocol_environment_alpha__Environment.Format.formatter -> t -> unit.
  
  Definition voting_period := t.
  
  Parameter rpc_arg :
    Tezos_protocol_environment_alpha__Environment.RPC_arg.arg voting_period.
  
  Parameter root : voting_period.
  
  Parameter succ : voting_period -> voting_period.
  
  Inductive kind : Set :=
  | Proposal : kind
  | Testing_vote : kind
  | Testing : kind
  | Promotion_vote : kind.
  
  Parameter kind_encoding :
    Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding kind.
  
  Parameter to_int32 : voting_period -> int32.
End Voting_period.

Module Level.
  Module t.
    Record record := {
      level : Raw_level.t;
      level_position : int32;
      cycle : Cycle.t;
      cycle_position : int32;
      voting_period : Voting_period.t;
      voting_period_position : int32;
      expected_commitment : bool }.
  End t.
  Definition t := t.record.
  
  Parameter op_eq : t -> t -> bool.
  
  Parameter op_ltgt : t -> t -> bool.
  
  Parameter op_lt : t -> t -> bool.
  
  Parameter op_lteq : t -> t -> bool.
  
  Parameter op_gteq : t -> t -> bool.
  
  Parameter op_gt : t -> t -> bool.
  
  Parameter compare : t -> t -> Z.
  
  Parameter equal : t -> t -> bool.
  
  Parameter max : t -> t -> t.
  
  Parameter min : t -> t -> t.
  
  Parameter encoding :
    Tezos_protocol_environment_alpha__Environment.Data_encoding.t t.
  
  Parameter pp :
    Tezos_protocol_environment_alpha__Environment.Format.formatter -> t -> unit.
  
  Parameter pp_full :
    Tezos_protocol_environment_alpha__Environment.Format.formatter -> t -> unit.
  
  Definition level := t.
  
  Parameter root : context -> level.
  
  Parameter succ : context -> level -> level.
  
  Parameter pred : context -> level -> option level.
  
  Parameter from_raw : context -> option int32 -> Raw_level.t -> level.
  
  Parameter diff : level -> level -> int32.
  
  Parameter current : context -> level.
  
  Parameter last_level_in_cycle : context -> Cycle.t -> level.
  
  Parameter levels_in_cycle : context -> Cycle.t -> list level.
  
  Parameter levels_in_current_cycle :
    context -> option int32 -> unit -> list level.
  
  Parameter last_allowed_fork_level : context -> Raw_level.t.
End Level.

Module Fitness.
  Definition t := list Tezos_protocol_environment_alpha__Environment.MBytes.t.
  
  Parameter op_eq : t -> t -> bool.
  
  Parameter op_ltgt : t -> t -> bool.
  
  Parameter op_lt : t -> t -> bool.
  
  Parameter op_lteq : t -> t -> bool.
  
  Parameter op_gteq : t -> t -> bool.
  
  Parameter op_gt : t -> t -> bool.
  
  Parameter compare : t -> t -> Z.
  
  Parameter equal : t -> t -> bool.
  
  Parameter max : t -> t -> t.
  
  Parameter min : t -> t -> t.
  
  Parameter pp :
    Tezos_protocol_environment_alpha__Environment.Format.formatter -> t -> unit.
  
  Parameter encoding :
    Tezos_protocol_environment_alpha__Environment.Data_encoding.t t.
  
  Parameter to_bytes :
    t -> Tezos_protocol_environment_alpha__Environment.MBytes.t.
  
  Parameter of_bytes :
    Tezos_protocol_environment_alpha__Environment.MBytes.t -> option t.
  
  Definition fitness := t.
  
  Parameter increase : option Z -> context -> context.
  
  Parameter current : context -> int64.
  
  Parameter to_int64 :
    fitness ->
    Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult int64.
End Fitness.

Module Nonce.
  Parameter t : Set.
  
  Definition nonce := t.
  
  Parameter encoding :
    Tezos_protocol_environment_alpha__Environment.Data_encoding.t nonce.
  
  Module unrevealed.
    Record record := {
      nonce_hash : Tezos_raw_protocol_alpha.Nonce_hash.t;
      delegate : public_key_hash;
      rewards : Tez.t;
      fees : Tez.t }.
  End unrevealed.
  Definition unrevealed := unrevealed.record.
  
  Parameter record_hash :
    context -> unrevealed ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        context).
  
  Parameter reveal :
    context -> Level.t -> nonce ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        context).
  
  Inductive status : Set :=
  | Unrevealed : unrevealed -> status
  | Revealed : nonce -> status.
  
  Parameter get :
    context -> Level.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult status).
  
  Parameter of_bytes :
    Tezos_protocol_environment_alpha__Environment.MBytes.t ->
    Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult nonce.
  
  Parameter __hash_value : nonce -> Tezos_raw_protocol_alpha.Nonce_hash.t.
  
  Parameter check_hash : nonce -> Tezos_raw_protocol_alpha.Nonce_hash.t -> bool.
End Nonce.

Module Seed.
  Parameter seed : Set.
  
  (* extensible_type Tezos_protocol_environment_alpha__Environment.Error_monad.error *)
  
  Parameter for_cycle :
    context -> Cycle.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult seed).
  
  Parameter cycle_end :
    context -> Cycle.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (context * list Nonce.unrevealed)).
  
  Parameter seed_encoding :
    Tezos_protocol_environment_alpha__Environment.Data_encoding.t seed.
End Seed.

Module Big_map.
  Definition id := Tezos_protocol_environment_alpha__Environment.Z.t.
  
  Parameter fresh :
    context ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (context * id)).
  
  Parameter fresh_temporary : context -> context * id.
  
  Parameter mem :
    context -> id -> Tezos_raw_protocol_alpha.Script_expr_hash.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (context * bool)).
  
  Parameter get_opt :
    context -> id -> Tezos_raw_protocol_alpha.Script_expr_hash.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (context * option Script.expr)).
  
  Parameter rpc_arg :
    Tezos_protocol_environment_alpha__Environment.RPC_arg.t id.
  
  Parameter cleanup_temporary :
    context -> Tezos_protocol_environment_alpha__Environment.Lwt.t context.
  
  Parameter __exists :
    context -> id ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (context * option (Script.expr * Script.expr))).
End Big_map.

Module Contract.
  Parameter t : Set.
  
  Parameter op_eq : t -> t -> bool.
  
  Parameter op_ltgt : t -> t -> bool.
  
  Parameter op_lt : t -> t -> bool.
  
  Parameter op_lteq : t -> t -> bool.
  
  Parameter op_gteq : t -> t -> bool.
  
  Parameter op_gt : t -> t -> bool.
  
  Parameter compare : t -> t -> Z.
  
  Parameter equal : t -> t -> bool.
  
  Parameter max : t -> t -> t.
  
  Parameter min : t -> t -> t.
  
  Parameter encoding :
    Tezos_protocol_environment_alpha__Environment.Data_encoding.t t.
  
  Parameter pp :
    Tezos_protocol_environment_alpha__Environment.Format.formatter -> t -> unit.
  
  Definition contract := t.
  
  Parameter rpc_arg :
    Tezos_protocol_environment_alpha__Environment.RPC_arg.arg contract.
  
  Parameter to_b58check : contract -> string.
  
  Parameter of_b58check :
    string ->
    Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult contract.
  
  Parameter implicit_contract : public_key_hash -> contract.
  
  Parameter is_implicit : contract -> option public_key_hash.
  
  Parameter __exists :
    context -> contract ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult bool).
  
  Parameter must_exist :
    context -> contract ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit).
  
  Parameter allocated :
    context -> contract ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult bool).
  
  Parameter must_be_allocated :
    context -> contract ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit).
  
  Parameter __list_value :
    context ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t (list contract).
  
  Parameter get_manager_key :
    context -> public_key_hash ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        public_key).
  
  Parameter is_manager_key_revealed :
    context -> public_key_hash ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult bool).
  
  Parameter reveal_manager_key :
    context -> public_key_hash -> public_key ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        context).
  
  Parameter get_script_code :
    context -> contract ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (context * option Script.lazy_expr)).
  
  Parameter get_script :
    context -> contract ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (context * option Script.t)).
  
  Parameter get_storage :
    context -> contract ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (context * option Script.expr)).
  
  Parameter get_counter :
    context -> public_key_hash ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        Tezos_protocol_environment_alpha__Environment.Z.t).
  
  Parameter get_balance :
    context -> contract ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult Tez.t).
  
  Parameter init_origination_nonce :
    context -> Tezos_protocol_environment_alpha__Environment.Operation_hash.t ->
    context.
  
  Parameter unset_origination_nonce : context -> context.
  
  Parameter fresh_contract_from_current_nonce :
    context ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (context * t)).
  
  Parameter originated_from_current_nonce :
    context -> context ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (list contract)).
  
  Inductive big_map_diff_item : Set :=
  | Update :
    Big_map.id -> Script.expr -> Tezos_raw_protocol_alpha.Script_expr_hash.t ->
    option Script.expr -> big_map_diff_item
  | Clear : Big_map.id -> big_map_diff_item
  | Copy : Big_map.id -> Big_map.id -> big_map_diff_item
  | Alloc : Big_map.id -> Script.expr -> Script.expr -> big_map_diff_item.
  
  Definition big_map_diff := list big_map_diff_item.
  
  Parameter big_map_diff_encoding :
    Tezos_protocol_environment_alpha__Environment.Data_encoding.t big_map_diff.
  
  Parameter originate :
    context -> contract -> Tez.t -> Script.t * option big_map_diff ->
    option public_key_hash ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        context).
  
  (* extensible_type Tezos_protocol_environment_alpha__Environment.Error_monad.error *)
  
  Parameter spend :
    context -> contract -> Tez.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        context).
  
  Parameter credit :
    context -> contract -> Tez.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        context).
  
  Parameter update_script_storage :
    context -> contract -> Script.expr -> option big_map_diff ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        context).
  
  Parameter used_storage_space :
    context -> t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        Tezos_protocol_environment_alpha__Environment.Z.t).
  
  Parameter increment_counter :
    context -> public_key_hash ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        context).
  
  Parameter check_counter_increment :
    context -> public_key_hash ->
    Tezos_protocol_environment_alpha__Environment.Z.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit).
  
  Parameter origination_nonce : Set.
  
  Parameter initial_origination_nonce :
    Tezos_protocol_environment_alpha__Environment.Operation_hash.t ->
    origination_nonce.
  
  Parameter originated_contract : origination_nonce -> contract.
End Contract.

Module Delegate.
  Inductive balance : Set :=
  | Contract : Contract.t -> balance
  | Rewards :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
    Cycle.t -> balance
  | Fees :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
    Cycle.t -> balance
  | Deposits :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
    Cycle.t -> balance.
  
  Inductive balance_update : Set :=
  | Debited : Tez.t -> balance_update
  | Credited : Tez.t -> balance_update.
  
  Definition balance_updates := list (balance * balance_update).
  
  Parameter balance_updates_encoding :
    Tezos_protocol_environment_alpha__Environment.Data_encoding.t
      balance_updates.
  
  Parameter cleanup_balance_updates : balance_updates -> balance_updates.
  
  Parameter get :
    context -> Contract.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (option public_key_hash)).
  
  Parameter set :
    context -> Contract.t -> option public_key_hash ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        context).
  
  Parameter fold : forall {a : Set},
    context -> a ->
    (public_key_hash -> a ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t a.
  
  Parameter __list_value :
    context ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t (list public_key_hash).
  
  Parameter freeze_deposit :
    context -> public_key_hash -> Tez.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        context).
  
  Parameter freeze_rewards :
    context -> public_key_hash -> Tez.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        context).
  
  Parameter freeze_fees :
    context -> public_key_hash -> Tez.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        context).
  
  Parameter cycle_end :
    context -> Cycle.t -> list Nonce.unrevealed ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (context * balance_updates *
          list
            Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)).
  
  Module frozen_balance.
    Record record := {
      deposit : Tez.t;
      fees : Tez.t;
      rewards : Tez.t }.
  End frozen_balance.
  Definition frozen_balance := frozen_balance.record.
  
  Parameter punish :
    context -> public_key_hash -> Cycle.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (context * frozen_balance)).
  
  Parameter full_balance :
    context -> public_key_hash ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult Tez.t).
  
  Parameter has_frozen_balance :
    context -> public_key_hash -> Cycle.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult bool).
  
  Parameter frozen_balance :
    context -> public_key_hash ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult Tez.t).
  
  Parameter frozen_balance_encoding :
    Tezos_protocol_environment_alpha__Environment.Data_encoding.t frozen_balance.
  
  Parameter frozen_balance_by_cycle_encoding :
    Tezos_protocol_environment_alpha__Environment.Data_encoding.t
      (Cycle.Map.t frozen_balance).
  
  Parameter frozen_balance_by_cycle :
    context ->
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Cycle.Map.t frozen_balance).
  
  Parameter staking_balance :
    context ->
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult Tez.t).
  
  Parameter delegated_contracts :
    context ->
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (list Tezos_raw_protocol_alpha.Contract_repr.t).
  
  Parameter delegated_balance :
    context ->
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult Tez.t).
  
  Parameter deactivated :
    context ->
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult bool).
  
  Parameter grace_period :
    context ->
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        Cycle.t).
End Delegate.

Module Vote.
  Definition proposal :=
    Tezos_protocol_environment_alpha__Environment.Protocol_hash.t.
  
  Parameter record_proposal :
    context -> Tezos_protocol_environment_alpha__Environment.Protocol_hash.t ->
    public_key_hash ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        context).
  
  Parameter get_proposals :
    context ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (Tezos_protocol_environment_alpha__Environment.Protocol_hash.Map.t int32)).
  
  Parameter clear_proposals :
    context -> Tezos_protocol_environment_alpha__Environment.Lwt.t context.
  
  Parameter recorded_proposal_count_for_delegate :
    context -> public_key_hash ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult Z).
  
  Parameter listings_encoding :
    Tezos_protocol_environment_alpha__Environment.Data_encoding.t
      (list
        (Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t
          * int32)).
  
  Parameter freeze_listings :
    context ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        context).
  
  Parameter clear_listings :
    context ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        context).
  
  Parameter listing_size :
    context ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult int32).
  
  Parameter in_listings :
    context -> public_key_hash ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t bool.
  
  Parameter get_listings :
    context ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (list (public_key_hash * int32)).
  
  Inductive ballot : Set :=
  | Yay : ballot
  | Nay : ballot
  | Pass : ballot.
  
  Parameter ballot_encoding :
    Tezos_protocol_environment_alpha__Environment.Data_encoding.t ballot.
  
  Module ballots.
    Record record := {
      yay : int32;
      nay : int32;
      pass : int32 }.
  End ballots.
  Definition ballots := ballots.record.
  
  Parameter ballots_encoding :
    Tezos_protocol_environment_alpha__Environment.Data_encoding.t ballots.
  
  Parameter has_recorded_ballot :
    context -> public_key_hash ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t bool.
  
  Parameter record_ballot :
    context -> public_key_hash -> ballot ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        context).
  
  Parameter get_ballots :
    context ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        ballots).
  
  Parameter get_ballot_list :
    context ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (list
        (Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t
          * ballot)).
  
  Parameter clear_ballots :
    context -> Tezos_protocol_environment_alpha__Environment.Lwt.t context.
  
  Parameter get_current_period_kind :
    context ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        Voting_period.kind).
  
  Parameter set_current_period_kind :
    context -> Voting_period.kind ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        context).
  
  Parameter get_current_quorum :
    context ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult int32).
  
  Parameter get_participation_ema :
    context ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult int32).
  
  Parameter set_participation_ema :
    context -> int32 ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        context).
  
  Parameter get_current_proposal :
    context ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        proposal).
  
  Parameter init_current_proposal :
    context -> proposal ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        context).
  
  Parameter clear_current_proposal :
    context ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        context).
End Vote.

Module Block_header.
  Reserved Notation "'t".
  Reserved Notation "'protocol_data".
  Reserved Notation "'contents".
  
  Module contents_skeleton.
    Record record {priority seed_nonce_hash proof_of_work_nonce : Set} := {
      priority : priority;
      seed_nonce_hash : seed_nonce_hash;
      proof_of_work_nonce : proof_of_work_nonce }.
    Arguments record : clear implicits.
  End contents_skeleton.
  Definition contents_skeleton := contents_skeleton.record.
  
  Module protocol_data_skeleton.
    Record record {contents signature : Set} := {
      contents : contents;
      signature : signature }.
    Arguments record : clear implicits.
  End protocol_data_skeleton.
  Definition protocol_data_skeleton := protocol_data_skeleton.record.
  
  Module t_skeleton.
    Record record {shell protocol_data : Set} := {
      shell : shell;
      protocol_data : protocol_data }.
    Arguments record : clear implicits.
  End t_skeleton.
  Definition t_skeleton := t_skeleton.record.
  
  
  
  where "'t" :=
    (t_skeleton
      Tezos_protocol_environment_alpha__Environment.Block_header.shell_header
      'protocol_data)
  and "'protocol_data" :=
    (protocol_data_skeleton 'contents
      Tezos_protocol_environment_alpha__Environment.Signature.t)
  and "'contents" :=
    (contents_skeleton Z (option Tezos_raw_protocol_alpha.Nonce_hash.t)
      Tezos_protocol_environment_alpha__Environment.MBytes.t).
  
  Definition t := 't.
  Definition protocol_data := 'protocol_data.
  Definition contents := 'contents.
  
  Definition block_header := t.
  
  Definition raw :=
    Tezos_protocol_environment_alpha__Environment.Block_header.t.
  
  Definition shell_header :=
    Tezos_protocol_environment_alpha__Environment.Block_header.shell_header.
  
  Parameter raw : block_header -> raw.
  
  Parameter __hash_value :
    block_header -> Tezos_protocol_environment_alpha__Environment.Block_hash.t.
  
  Parameter hash_raw :
    raw -> Tezos_protocol_environment_alpha__Environment.Block_hash.t.
  
  Parameter encoding :
    Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
      block_header.
  
  Parameter raw_encoding :
    Tezos_protocol_environment_alpha__Environment.Data_encoding.t raw.
  
  Parameter contents_encoding :
    Tezos_protocol_environment_alpha__Environment.Data_encoding.t contents.
  
  Parameter unsigned_encoding :
    Tezos_protocol_environment_alpha__Environment.Data_encoding.t
      (shell_header * contents).
  
  Parameter protocol_data_encoding :
    Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
      protocol_data.
  
  Parameter shell_header_encoding :
    Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
      shell_header.
  
  Parameter max_header_length : Z.
End Block_header.

Module Kind.
  Inductive seed_nonce_revelation : Set :=
  | Seed_nonce_revelation_kind : seed_nonce_revelation.
  
  Inductive double_endorsement_evidence : Set :=
  | Double_endorsement_evidence_kind : double_endorsement_evidence.
  
  Inductive double_baking_evidence : Set :=
  | Double_baking_evidence_kind : double_baking_evidence.
  
  Inductive activate_account : Set :=
  | Activate_account_kind : activate_account.
  
  Inductive endorsement : Set :=
  | Endorsement_kind : endorsement.
  
  Inductive proposals : Set :=
  | Proposals_kind : proposals.
  
  Inductive ballot : Set :=
  | Ballot_kind : ballot.
  
  Inductive reveal : Set :=
  | Reveal_kind : reveal.
  
  Inductive transaction : Set :=
  | Transaction_kind : transaction.
  
  Inductive origination : Set :=
  | Origination_kind : origination.
  
  Inductive delegation : Set :=
  | Delegation_kind : delegation.
  
  Reserved Notation "'manager".
  
  Inductive manager_gadt : Set :=
  | Reveal_manager_kind : manager_gadt
  | Transaction_manager_kind : manager_gadt
  | Origination_manager_kind : manager_gadt
  | Delegation_manager_kind : manager_gadt
  
  where "'manager" := (fun (a : Set) => manager_gadt).
  
  Definition manager := 'manager.
End Kind.

Reserved Notation "'operation".
Reserved Notation "'protocol_data".
Reserved Notation "'contents_list".
Reserved Notation "'contents".
Reserved Notation "'manager_operation".
Reserved Notation "'counter".

Module protocol_data_skeleton.
  Record record {contents signature : Set} := {
    contents : contents;
    signature : signature }.
  Arguments record : clear implicits.
End protocol_data_skeleton.
Definition protocol_data_skeleton := protocol_data_skeleton.record.

Module operation_skeleton.
  Record record {shell protocol_data : Set} := {
    shell : shell;
    protocol_data : protocol_data }.
  Arguments record : clear implicits.
End operation_skeleton.
Definition operation_skeleton := operation_skeleton.record.

Inductive contents_list_gadt : Set :=
| Single : forall {kind : Set}, 'contents kind -> contents_list_gadt
| Cons : forall {kind : Set},
  'contents (Kind.manager kind) -> contents_list_gadt -> contents_list_gadt

with contents_gadt : Set :=
| Endorsement : Raw_level.t -> contents_gadt
| Seed_nonce_revelation : Raw_level.t -> Nonce.t -> contents_gadt
| Double_endorsement_evidence :
  'operation Kind.endorsement -> 'operation Kind.endorsement -> contents_gadt
| Double_baking_evidence : Block_header.t -> Block_header.t -> contents_gadt
| Activate_account :
  Tezos_protocol_environment_alpha__Environment.Ed25519.Public_key_hash.t ->
  Tezos_raw_protocol_alpha.Blinded_public_key_hash.activation_code ->
  contents_gadt
| Proposals :
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Voting_period.t ->
  list Tezos_protocol_environment_alpha__Environment.Protocol_hash.t ->
  contents_gadt
| Ballot :
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Voting_period.t ->
  Tezos_protocol_environment_alpha__Environment.Protocol_hash.t ->
  Vote.ballot -> contents_gadt
| Manager_operation : forall {kind : Set},
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Tez.tez -> 'counter -> 'manager_operation kind ->
  Tezos_protocol_environment_alpha__Environment.Z.t ->
  Tezos_protocol_environment_alpha__Environment.Z.t -> contents_gadt

with manager_operation_gadt : Set :=
| Reveal :
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t ->
  manager_operation_gadt
| Transaction :
  Tez.tez -> Script.lazy_expr -> string -> Contract.contract ->
  manager_operation_gadt
| Origination :
  option
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Script.t -> Tez.tez -> option Contract.t -> manager_operation_gadt
| Delegation :
  option
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  manager_operation_gadt

where "'operation" := (fun (kind : Set) =>
  operation_skeleton
    Tezos_protocol_environment_alpha__Environment.Operation.shell_header
    ('protocol_data kind))
and "'protocol_data" := (fun (kind : Set) =>
  protocol_data_skeleton ('contents_list kind)
    (option Tezos_protocol_environment_alpha__Environment.Signature.t))
and "'contents_list" := (fun (_ : Set) => contents_list_gadt)
and "'contents" := (fun (_ : Set) => contents_gadt)
and "'manager_operation" := (fun (_ : Set) => manager_operation_gadt)
and "'counter" := (Tezos_protocol_environment_alpha__Environment.Z.t).

Definition operation := 'operation.
Definition protocol_data := 'protocol_data.
Definition contents_list := 'contents_list.
Definition contents := 'contents.
Definition manager_operation := 'manager_operation.
Definition counter := 'counter.

Module internal_operation.
  Record record {kind : Set} := {
    source : Contract.contract;
    operation : manager_operation kind;
    nonce : Z }.
  Arguments record : clear implicits.
End internal_operation.
Definition internal_operation := internal_operation.record.

Reserved Notation "'packed_manager_operation".

Inductive packed_manager_operation_gadt : Set :=
| Manager : forall {kind : Set},
  manager_operation kind -> packed_manager_operation_gadt

where "'packed_manager_operation" := (packed_manager_operation_gadt).

Definition packed_manager_operation := 'packed_manager_operation.

Reserved Notation "'packed_contents".

Inductive packed_contents_gadt : Set :=
| Contents : forall {kind : Set}, contents kind -> packed_contents_gadt

where "'packed_contents" := (packed_contents_gadt).

Definition packed_contents := 'packed_contents.

Reserved Notation "'packed_contents_list".

Inductive packed_contents_list_gadt : Set :=
| Contents_list : forall {kind : Set},
  contents_list kind -> packed_contents_list_gadt

where "'packed_contents_list" := (packed_contents_list_gadt).

Definition packed_contents_list := 'packed_contents_list.

Reserved Notation "'packed_protocol_data".

Inductive packed_protocol_data_gadt : Set :=
| Operation_data : forall {kind : Set},
  protocol_data kind -> packed_protocol_data_gadt

where "'packed_protocol_data" := (packed_protocol_data_gadt).

Definition packed_protocol_data := 'packed_protocol_data.

Module packed_operation.
  Record record := {
    shell : Tezos_protocol_environment_alpha__Environment.Operation.shell_header;
    protocol_data : packed_protocol_data }.
End packed_operation.
Definition packed_operation := packed_operation.record.

Reserved Notation "'packed_internal_operation".

Inductive packed_internal_operation_gadt : Set :=
| Internal_operation : forall {kind : Set},
  internal_operation kind -> packed_internal_operation_gadt

where "'packed_internal_operation" := (packed_internal_operation_gadt).

Definition packed_internal_operation := 'packed_internal_operation.

Parameter manager_kind : forall {kind : Set},
  manager_operation kind -> Kind.manager kind.

Module Fees.
  Parameter origination_burn :
    context ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (context * Tez.t)).
  
  Parameter record_paid_storage_space :
    context -> Contract.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (context * Tezos_protocol_environment_alpha__Environment.Z.t *
          Tezos_protocol_environment_alpha__Environment.Z.t * Tez.t)).
  
  Parameter start_counting_storage_fees : context -> context.
  
  Parameter burn_storage_fees :
    context -> Tezos_protocol_environment_alpha__Environment.Z.t ->
    Contract.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        context).
  
  (* extensible_type Tezos_protocol_environment_alpha__Environment.Error_monad.error *)
  
  (* extensible_type Tezos_protocol_environment_alpha__Environment.Error_monad.error *)
  
  (* extensible_type Tezos_protocol_environment_alpha__Environment.Error_monad.error *)
  
  Parameter check_storage_limit :
    context -> Tezos_protocol_environment_alpha__Environment.Z.t ->
    Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit.
End Fees.

Module Operation.
  Definition contents (kind : Set) := contents kind.
  
  Definition packed_contents := packed_contents.
  
  Parameter contents_encoding :
    Tezos_protocol_environment_alpha__Environment.Data_encoding.t
      packed_contents.
  
  Definition protocol_data (kind : Set) := protocol_data kind.
  
  Definition packed_protocol_data := packed_protocol_data.
  
  Parameter protocol_data_encoding :
    Tezos_protocol_environment_alpha__Environment.Data_encoding.t
      packed_protocol_data.
  
  Parameter unsigned_encoding :
    Tezos_protocol_environment_alpha__Environment.Data_encoding.t
      (Tezos_protocol_environment_alpha__Environment.Operation.shell_header *
        packed_contents_list).
  
  Module raw.
    Record record := {
      shell :
        Tezos_protocol_environment_alpha__Environment.Operation.shell_header;
      proto : Tezos_protocol_environment_alpha__Environment.MBytes.t }.
  End raw.
  Definition raw := raw.record.
  
  Parameter raw_encoding :
    Tezos_protocol_environment_alpha__Environment.Data_encoding.t raw.
  
  Parameter contents_list_encoding :
    Tezos_protocol_environment_alpha__Environment.Data_encoding.t
      packed_contents_list.
  
  Module t.
    Record record {kind : Set} := {
      shell :
        Tezos_protocol_environment_alpha__Environment.Operation.shell_header;
      protocol_data : protocol_data kind }.
    Arguments record : clear implicits.
  End t.
  Definition t := t.record.
  
  Definition packed := packed_operation.
  
  Parameter encoding :
    Tezos_protocol_environment_alpha__Environment.Data_encoding.t packed.
  
  Parameter raw : forall {A : Set}, operation A -> raw.
  
  Parameter __hash_value : forall {A : Set},
    operation A ->
    Tezos_protocol_environment_alpha__Environment.Operation_hash.t.
  
  Parameter hash_raw :
    raw -> Tezos_protocol_environment_alpha__Environment.Operation_hash.t.
  
  Parameter hash_packed :
    packed_operation ->
    Tezos_protocol_environment_alpha__Environment.Operation_hash.t.
  
  Parameter acceptable_passes : packed_operation -> list Z.
  
  (* extensible_type Tezos_protocol_environment_alpha__Environment.Error_monad.error *)
  
  (* extensible_type Tezos_protocol_environment_alpha__Environment.Error_monad.error *)
  
  Parameter check_signature : forall {A : Set},
    public_key -> Tezos_protocol_environment_alpha__Environment.Chain_id.t ->
    operation A ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit).
  
  Parameter check_signature_sync : forall {A : Set},
    public_key -> Tezos_protocol_environment_alpha__Environment.Chain_id.t ->
    operation A ->
    Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit.
  
  Parameter internal_operation_encoding :
    Tezos_protocol_environment_alpha__Environment.Data_encoding.t
      packed_internal_operation.
  
  Parameter pack : forall {kind : Set}, operation kind -> packed_operation.
  
  Reserved Notation "'eq".
  
  Inductive eq_gadt : Set :=
  | Eq : eq_gadt
  
  where "'eq" := (fun (a b : Set) => eq_gadt).
  
  Definition eq := 'eq.
  
  Parameter equal : forall {a b : Set},
    operation a -> operation b -> option (eq a b).
  
  Module Encoding.
    Reserved Notation "'case".
    
    Inductive case_gadt : Set :=
    | Case : forall {a b : Set},
      Z -> string ->
      Tezos_protocol_environment_alpha__Environment.Data_encoding.t a ->
      (packed_contents -> option (contents b)) -> (contents b -> a) ->
      (a -> contents b) -> case_gadt
    
    where "'case" := (fun (b : Set) => case_gadt).
    
    Definition case := 'case.
    
    Parameter endorsement_case : case Kind.endorsement.
    
    Parameter seed_nonce_revelation_case : case Kind.seed_nonce_revelation.
    
    Parameter double_endorsement_evidence_case :
      case Kind.double_endorsement_evidence.
    
    Parameter double_baking_evidence_case : case Kind.double_baking_evidence.
    
    Parameter activate_account_case : case Kind.activate_account.
    
    Parameter proposals_case : case Kind.proposals.
    
    Parameter ballot_case : case Kind.ballot.
    
    Parameter reveal_case : case (Kind.manager Kind.reveal).
    
    Parameter transaction_case : case (Kind.manager Kind.transaction).
    
    Parameter origination_case : case (Kind.manager Kind.origination).
    
    Parameter delegation_case : case (Kind.manager Kind.delegation).
    
    Module Manager_operations.
      Reserved Notation "'case".
      
      Inductive case_gadt : Set :=
      | MCase : forall {a kind : Set},
        Z -> string ->
        Tezos_protocol_environment_alpha__Environment.Data_encoding.t a ->
        (packed_manager_operation -> option (manager_operation kind)) ->
        (manager_operation kind -> a) -> (a -> manager_operation kind) ->
        case_gadt
      
      where "'case" := (fun (b : Set) => case_gadt).
      
      Definition case := 'case.
      
      Parameter reveal_case : case Kind.reveal.
      
      Parameter transaction_case : case Kind.transaction.
      
      Parameter origination_case : case Kind.origination.
      
      Parameter delegation_case : case Kind.delegation.
    End Manager_operations.
  End Encoding.
  
  Parameter of_list : list packed_contents -> packed_contents_list.
  
  Parameter to_list : packed_contents_list -> list packed_contents.
End Operation.

Module Roll.
  Definition t := int32.
  
  Definition roll := t.
  
  Parameter encoding :
    Tezos_protocol_environment_alpha__Environment.Data_encoding.t roll.
  
  Parameter snapshot_rolls :
    context ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        context).
  
  Parameter cycle_end :
    context -> Cycle.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        context).
  
  Parameter baking_rights_owner :
    context -> Level.t -> Z ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        public_key).
  
  Parameter endorsement_rights_owner :
    context -> Level.t -> Z ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        public_key).
  
  Parameter delegate_pubkey :
    context -> public_key_hash ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        public_key).
  
  Parameter get_rolls :
    context ->
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (list roll)).
  
  Parameter get_change :
    context ->
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult Tez.t).
End Roll.

Module Commitment.
  Module t.
    Record record := {
      blinded_public_key_hash :
        Tezos_raw_protocol_alpha.Blinded_public_key_hash.t;
      amount : Tez.tez }.
  End t.
  Definition t := t.record.
  
  Parameter get_opt :
    context -> Tezos_raw_protocol_alpha.Blinded_public_key_hash.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (option Tez.t)).
  
  Parameter delete :
    context -> Tezos_raw_protocol_alpha.Blinded_public_key_hash.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        context).
End Commitment.

Module Bootstrap.
  Parameter cycle_end :
    context -> Cycle.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        context).
End Bootstrap.

Module Global.
  Parameter get_block_priority :
    context ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult Z).
  
  Parameter set_block_priority :
    context -> Z ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        context).
End Global.

Parameter prepare_first_block :
  Tezos_protocol_environment_alpha__Environment.Context.t ->
  (context -> Script.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      ((Script.t * option Contract.big_map_diff) * context))) ->
  Tezos_protocol_environment_alpha__Environment.Int32.t ->
  Tezos_protocol_environment_alpha__Environment.Time.t -> Fitness.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult context).

Parameter prepare :
  Tezos_protocol_environment_alpha__Environment.Context.t ->
  Tezos_protocol_environment_alpha__Environment.Int32.t ->
  Tezos_protocol_environment_alpha__Environment.Time.t ->
  Tezos_protocol_environment_alpha__Environment.Time.t -> Fitness.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult context).

Parameter finalize :
  option string -> context ->
  Tezos_protocol_environment_alpha__Environment.Updater.validation_result.

Parameter activate :
  context -> Tezos_protocol_environment_alpha__Environment.Protocol_hash.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t context.

Parameter fork_test_chain :
  context -> Tezos_protocol_environment_alpha__Environment.Protocol_hash.t ->
  Tezos_protocol_environment_alpha__Environment.Time.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t context.

Parameter record_endorsement :
  context ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  context.

Parameter allowed_endorsements :
  context ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.Map.t
    (Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t *
      list Z * bool).

Parameter init_endorsements :
  context ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.Map.t
    (Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t *
      list Z * bool) -> context.

Parameter included_endorsements : context -> Z.

Parameter reset_internal_nonce : context -> context.

Parameter fresh_internal_nonce :
  context ->
  Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (context * Z).

Parameter record_internal_nonce : context -> Z -> context.

Parameter internal_nonce_already_recorded : context -> Z -> bool.

Parameter add_fees :
  context -> Tez.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult context).

Parameter add_rewards :
  context -> Tez.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult context).

Parameter add_deposit :
  context ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Tez.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult context).

Parameter get_fees : context -> Tez.t.

Parameter get_rewards : context -> Tez.t.

Parameter get_deposits :
  context ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.Map.t
    Tez.t.

Parameter description : Tezos_raw_protocol_alpha.Storage_description.t context.

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Alpha_context

let custom_root = RPC_path.open_root

module Seed = struct
  module S = struct
    open Data_encoding

    let seed =
      RPC_service.post_service
        ~description:"Seed of the cycle to which the block belongs."
        ~query:RPC_query.empty
        ~input:empty
        ~output:Seed.seed_encoding
        RPC_path.(custom_root / "context" / "seed")
  end

  let () =
    let open Services_registration in
    register0 S.seed (fun ctxt () () ->
        let l = Level.current ctxt in
        Seed.for_cycle ctxt l.cycle)

  let get ctxt block = RPC_context.make_call0 S.seed ctxt block () ()
end

module Nonce = struct
  type info = Revealed of Nonce.t | Missing of Nonce_hash.t | Forgotten

  let info_encoding =
    let open Data_encoding in
    union
      [ case
          (Tag 0)
          ~title:"Revealed"
          (obj1 (req "nonce" Nonce.encoding))
          (function Revealed nonce -> Some nonce | _ -> None)
          (fun nonce -> Revealed nonce);
        case
          (Tag 1)
          ~title:"Missing"
          (obj1 (req "hash" Nonce_hash.encoding))
          (function Missing nonce -> Some nonce | _ -> None)
          (fun nonce -> Missing nonce);
        case
          (Tag 2)
          ~title:"Forgotten"
          empty
          (function Forgotten -> Some () | _ -> None)
          (fun () -> Forgotten) ]

  module S = struct
    let get =
      RPC_service.get_service
        ~description:"Info about the nonce of a previous block."
        ~query:RPC_query.empty
        ~output:info_encoding
        RPC_path.(custom_root / "context" / "nonces" /: Raw_level.rpc_arg)
  end

  let register () =
    let open Services_registration in
    register1 S.get (fun ctxt raw_level () () ->
        let level = Level.from_raw ctxt raw_level in
        Nonce.get ctxt level
        >>= function
        | Ok (Revealed nonce) ->
            return (Revealed nonce)
        | Ok (Unrevealed {nonce_hash; _}) ->
            return (Missing nonce_hash)
        | Error _ ->
            return Forgotten)

  let get ctxt block level =
    RPC_context.make_call1 S.get ctxt block level () ()
end

module Contract = Contract_services
module Constants = Constants_services
module Delegate = Delegate_services
module Helpers = Helpers_services
module Forge = Helpers_services.Forge
module Parse = Helpers_services.Parse
module Voting = Voting_services

let register () =
  Contract.register () ;
  Constants.register () ;
  Delegate.register () ;
  Helpers.register () ;
  Nonce.register () ;
  Voting.register ()

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Import Alpha_context.

Definition custom_root {A : Set}
  : Tezos_protocol_environment_alpha__Environment.RPC_path.context A :=
  RPC_path.open_root.

Module Seed.
  Module S.
    Import Data_encoding.
    
    Definition seed
      : Tezos_protocol_environment_alpha__Environment.RPC_service.service
        (* `POST *) unit
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context unit
        unit Tezos_raw_protocol_alpha.Alpha_context.Seed.seed :=
      RPC_service.post_service
        (Some "Seed of the cycle to which the block belongs." % string)
        RPC_query.empty empty Seed.seed_encoding
        (op_div (op_div custom_root "context" % string) "seed" % string).
  End S.
  
  (* ❌ Top-level evaluations are considered as an error as sources of side-effects *)
  Compute
    register0 S.seed
      (fun ctxt =>
        fun function_parameter =>
          let 'tt := function_parameter in
          fun function_parameter =>
            let 'tt := function_parameter in
            let l := Level.current ctxt in
            Seed.for_cycle ctxt
              (Tezos_raw_protocol_alpha.Alpha_context.Level.t.cycle l)).
  
  Definition get {D E G I K L a b c i o q : Set}
    (ctxt :
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
          (* `POST *) unit + (* `PUT *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
      D -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (E * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
            (* `POST *) unit + (* `PUT *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i
          o -> D -> a -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (G * a * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
              (* `POST *) unit + (* `PUT *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
              b) q i o -> D -> a -> b -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (I * a * b * q * i * o)) *
            (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
              ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
                (* `POST *) unit + (* `PUT *) unit)
              Tezos_protocol_environment_alpha__Environment.RPC_context.t
              (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
                * b) * c) q i o -> D -> a -> b -> c -> q -> i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (K * a * b * c * q * i * o)) * L)))) * L * D) (block : D)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        Tezos_raw_protocol_alpha.Alpha_context.Seed.seed) :=
    RPC_context.make_call0 S.seed ctxt block tt tt.
End Seed.

Module Nonce.
  Inductive info : Set :=
  | Revealed : Tezos_raw_protocol_alpha.Alpha_context.Nonce.t -> info
  | Missing : Tezos_raw_protocol_alpha.Nonce_hash.t -> info
  | Forgotten : info.
  
  Definition info_encoding
    : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding info :=
    union None
      (cons
        (__case_value "Revealed" % string None
          (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag 0)
          (obj1 (req None None "nonce" % string Nonce.encoding))
          (fun function_parameter =>
            match function_parameter with
            | Revealed nonce => Some nonce
            | _ => None
            end) (fun nonce => Revealed nonce))
        (cons
          (__case_value "Missing" % string None
            (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag 1)
            (obj1 (req None None "hash" % string Nonce_hash.encoding))
            (fun function_parameter =>
              match function_parameter with
              | Missing nonce => Some nonce
              | _ => None
              end) (fun nonce => Missing nonce))
          (cons
            (__case_value "Forgotten" % string None
              (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag 2)
              empty
              (fun function_parameter =>
                match function_parameter with
                | Forgotten => Some tt
                | _ => None
                end)
              (fun function_parameter =>
                let 'tt := function_parameter in
                Forgotten)) []))).
  
  Module S.
    Definition get
      : Tezos_protocol_environment_alpha__Environment.RPC_service.service
        (* `GET *) unit
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
        (Tezos_protocol_environment_alpha__Environment.Updater.rpc_context *
          Tezos_raw_protocol_alpha.Alpha_context.Raw_level.raw_level) unit unit
        info :=
      RPC_service.get_service
        (Some "Info about the nonce of a previous block." % string)
        RPC_query.empty info_encoding
        (op_divcolon
          (op_div (op_div custom_root "context" % string) "nonces" % string)
          Raw_level.rpc_arg).
  End S.
  
  Definition register (function_parameter : unit) : unit :=
    let 'tt := function_parameter in
    register1 S.get
      (fun ctxt =>
        fun raw_level =>
          fun function_parameter =>
            let 'tt := function_parameter in
            fun function_parameter =>
              let 'tt := function_parameter in
              let level := Level.from_raw ctxt None raw_level in
              op_gtgteq (Nonce.get ctxt level)
                (fun function_parameter =>
                  match function_parameter with
                  |
                    Tezos_protocol_environment_alpha__Environment.Pervasives.Ok
                      (Tezos_raw_protocol_alpha.Alpha_context.Nonce.Revealed
                        nonce) => __return (Revealed nonce)
                  |
                    Tezos_protocol_environment_alpha__Environment.Pervasives.Ok
                      (Tezos_raw_protocol_alpha.Alpha_context.Nonce.Unrevealed
                        {|
                        Tezos_raw_protocol_alpha.Alpha_context.Nonce.unrevealed.nonce_hash :=
                          nonce_hash
                          |}) => __return (Missing nonce_hash)
                  |
                    Tezos_protocol_environment_alpha__Environment.Pervasives.Error
                      _ => __return Forgotten
                  end)).
  
  Definition get {D E G I K L a b c i o q : Set}
    (ctxt :
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
          (* `POST *) unit + (* `PUT *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
      D -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (E * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
            (* `POST *) unit + (* `PUT *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i
          o -> D -> a -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (G * a * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
              (* `POST *) unit + (* `PUT *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
              b) q i o -> D -> a -> b -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (I * a * b * q * i * o)) *
            (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
              ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
                (* `POST *) unit + (* `PUT *) unit)
              Tezos_protocol_environment_alpha__Environment.RPC_context.t
              (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
                * b) * c) q i o -> D -> a -> b -> c -> q -> i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (K * a * b * c * q * i * o)) * L)))) * L * D) (block : D)
    (level : Tezos_raw_protocol_alpha.Alpha_context.Raw_level.raw_level)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        info) := RPC_context.make_call1 S.get ctxt block level tt tt.
End Nonce.

Module Contract := Contract_services.

Module Constants := Constants_services.

Module Delegate := Delegate_services.

Module Helpers := Helpers_services.

Module Forge := Helpers_services.Forge.

Module Parse := Helpers_services.Parse.

Module Voting := Voting_services.

Definition register (function_parameter : unit) : unit :=
  let 'tt := function_parameter in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ := Contract.register tt in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ := Constants.register tt in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ := Delegate.register tt in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ := Helpers.register tt in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ := Nonce.register tt in
  Voting.register tt.

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Alpha_context

module Seed : sig
  val get : 'a #RPC_context.simple -> 'a -> Seed.seed shell_tzresult Lwt.t
end

module Nonce : sig
  type info = Revealed of Nonce.t | Missing of Nonce_hash.t | Forgotten

  val get :
    'a #RPC_context.simple -> 'a -> Raw_level.t -> info shell_tzresult Lwt.t
end

module Contract = Contract_services
module Constants = Constants_services
module Delegate = Delegate_services
module Helpers = Helpers_services
module Forge = Helpers_services.Forge
module Parse = Helpers_services.Parse
module Voting = Voting_services

val register : unit -> unit

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Module Seed.
  Parameter get : forall {E F H J K a b c i o q : Set},
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit
        + (* `PATCH *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> a ->
    q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
          (* `POST *) unit + (* `PATCH *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
      -> a -> a -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (F * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
            (* `POST *) unit + (* `PATCH *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o -> a -> a -> b -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (H * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
              (* `POST *) unit + (* `PATCH *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o -> a -> a -> b -> c -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (J * a * b * c * q * i * o)) * K)))) * K * a -> a ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        Tezos_raw_protocol_alpha.Alpha_context.Seed.seed).
End Seed.

Module Nonce.
  Inductive info : Set :=
  | Revealed : Tezos_raw_protocol_alpha.Alpha_context.Nonce.t -> info
  | Missing : Tezos_raw_protocol_alpha.Nonce_hash.t -> info
  | Forgotten : info.
  
  Parameter get : forall {E F H J K a b c i o q : Set},
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit
        + (* `PATCH *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> a ->
    q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
          (* `POST *) unit + (* `PATCH *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
      -> a -> a -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (F * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
            (* `POST *) unit + (* `PATCH *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o -> a -> a -> b -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (H * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
              (* `POST *) unit + (* `PATCH *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o -> a -> a -> b -> c -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (J * a * b * c * q * i * o)) * K)))) * K * a -> a ->
    Tezos_raw_protocol_alpha.Alpha_context.Raw_level.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        info).
End Nonce.

Module Contract.
  (* Unhandled inlined abstract module *)
End Contract.

Module Constants.
  (* Unhandled inlined abstract module *)
End Constants.

Module Delegate.
  (* Unhandled inlined abstract module *)
End Delegate.

Module Helpers.
  (* Unhandled inlined abstract module *)
End Helpers.

Module Forge.
  (* Unhandled inlined abstract module *)
End Forge.

Module Parse.
  (* Unhandled inlined abstract module *)
End Parse.

Module Voting.
  (* Unhandled inlined abstract module *)
End Voting.

Parameter register : unit -> unit.

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Alpha_context

(** Returns the proposal submitted by the most delegates.
    Returns None in case of a tie, if proposal quorum is below required
    minimum or if there are no proposals. *)
let select_winning_proposal ctxt =
  Vote.get_proposals ctxt
  >>=? fun proposals ->
  let merge proposal vote winners =
    match winners with
    | None ->
        Some ([proposal], vote)
    | Some (winners, winners_vote) as previous ->
        if Compare.Int32.(vote = winners_vote) then
          Some (proposal :: winners, winners_vote)
        else if Compare.Int32.(vote > winners_vote) then Some ([proposal], vote)
        else previous
  in
  match Protocol_hash.Map.fold merge proposals None with
  | Some ([proposal], vote) ->
      Vote.listing_size ctxt
      >>=? fun max_vote ->
      let min_proposal_quorum = Constants.min_proposal_quorum ctxt in
      let min_vote_to_pass =
        Int32.div (Int32.mul min_proposal_quorum max_vote) 100_00l
      in
      if Compare.Int32.(vote >= min_vote_to_pass) then return_some proposal
      else return_none
  | _ ->
      return_none

(* in case of a tie, let's do nothing. *)

(** A proposal is approved if it has supermajority and the participation reaches
    the current quorum.
    Supermajority means the yays are more 8/10 of casted votes.
    The participation is the ratio of all received votes, including passes, with
    respect to the number of possible votes.
    The participation EMA (exponential moving average) uses the last
    participation EMA and the current participation./
    The expected quorum is calculated using the last participation EMA, capped
    by the min/max quorum protocol constants. *)
let check_approval_and_update_participation_ema ctxt =
  Vote.get_ballots ctxt
  >>=? fun ballots ->
  Vote.listing_size ctxt
  >>=? fun maximum_vote ->
  Vote.get_participation_ema ctxt
  >>=? fun participation_ema ->
  Vote.get_current_quorum ctxt
  >>=? fun expected_quorum ->
  (* Note overflows: considering a maximum of 8e8 tokens, with roll size as
     small as 1e3, there is a maximum of 8e5 rolls and thus votes.
     In 'participation' an Int64 is used because in the worst case 'all_votes is
     8e5 and after the multiplication is 8e9, making it potentially overflow a
     signed Int32 which is 2e9. *)
  let casted_votes = Int32.add ballots.yay ballots.nay in
  let all_votes = Int32.add casted_votes ballots.pass in
  let supermajority = Int32.div (Int32.mul 8l casted_votes) 10l in
  let participation =
    (* in centile of percentage *)
    Int64.(
      to_int32 (div (mul (of_int32 all_votes) 100_00L) (of_int32 maximum_vote)))
  in
  let outcome =
    Compare.Int32.(
      participation >= expected_quorum && ballots.yay >= supermajority)
  in
  let new_participation_ema =
    Int32.(div (add (mul 8l participation_ema) (mul 2l participation)) 10l)
  in
  Vote.set_participation_ema ctxt new_participation_ema
  >>=? fun ctxt -> return (ctxt, outcome)

(** Implements the state machine of the amendment procedure.
    Note that [freeze_listings], that computes the vote weight of each delegate,
    is run at the beginning of each voting period.
*)
let start_new_voting_period ctxt =
  Vote.get_current_period_kind ctxt
  >>=? function
  | Proposal -> (
      select_winning_proposal ctxt
      >>=? fun proposal ->
      Vote.clear_proposals ctxt
      >>= fun ctxt ->
      Vote.clear_listings ctxt
      >>=? fun ctxt ->
      match proposal with
      | None ->
          Vote.freeze_listings ctxt >>=? fun ctxt -> return ctxt
      | Some proposal ->
          Vote.init_current_proposal ctxt proposal
          >>=? fun ctxt ->
          Vote.freeze_listings ctxt
          >>=? fun ctxt ->
          Vote.set_current_period_kind ctxt Testing_vote
          >>=? fun ctxt -> return ctxt )
  | Testing_vote ->
      check_approval_and_update_participation_ema ctxt
      >>=? fun (ctxt, approved) ->
      Vote.clear_ballots ctxt
      >>= fun ctxt ->
      Vote.clear_listings ctxt
      >>=? fun ctxt ->
      if approved then
        let expiration =
          (* in two days maximum... *)
          Time.add
            (Timestamp.current ctxt)
            (Constants.test_chain_duration ctxt)
        in
        Vote.get_current_proposal ctxt
        >>=? fun proposal ->
        fork_test_chain ctxt proposal expiration
        >>= fun ctxt ->
        Vote.set_current_period_kind ctxt Testing >>=? fun ctxt -> return ctxt
      else
        Vote.clear_current_proposal ctxt
        >>=? fun ctxt ->
        Vote.freeze_listings ctxt
        >>=? fun ctxt ->
        Vote.set_current_period_kind ctxt Proposal >>=? fun ctxt -> return ctxt
  | Testing ->
      Vote.freeze_listings ctxt
      >>=? fun ctxt ->
      Vote.set_current_period_kind ctxt Promotion_vote
      >>=? fun ctxt -> return ctxt
  | Promotion_vote ->
      check_approval_and_update_participation_ema ctxt
      >>=? fun (ctxt, approved) ->
      ( if approved then
        Vote.get_current_proposal ctxt
        >>=? fun proposal -> activate ctxt proposal >>= fun ctxt -> return ctxt
      else return ctxt )
      >>=? fun ctxt ->
      Vote.clear_ballots ctxt
      >>= fun ctxt ->
      Vote.clear_listings ctxt
      >>=? fun ctxt ->
      Vote.clear_current_proposal ctxt
      >>=? fun ctxt ->
      Vote.freeze_listings ctxt
      >>=? fun ctxt ->
      Vote.set_current_period_kind ctxt Proposal >>=? fun ctxt -> return ctxt

type error +=
  | (* `Branch *)
      Invalid_proposal
  | Unexpected_proposal
  | Unauthorized_proposal
  | Too_many_proposals
  | Empty_proposal
  | Unexpected_ballot
  | Unauthorized_ballot

let () =
  let open Data_encoding in
  (* Invalid proposal *)
  register_error_kind
    `Branch
    ~id:"invalid_proposal"
    ~title:"Invalid proposal"
    ~description:"Ballot provided for a proposal that is not the current one."
    ~pp:(fun ppf () -> Format.fprintf ppf "Invalid proposal")
    empty
    (function Invalid_proposal -> Some () | _ -> None)
    (fun () -> Invalid_proposal) ;
  (* Unexpected proposal *)
  register_error_kind
    `Branch
    ~id:"unexpected_proposal"
    ~title:"Unexpected proposal"
    ~description:"Proposal recorded outside of a proposal period."
    ~pp:(fun ppf () -> Format.fprintf ppf "Unexpected proposal")
    empty
    (function Unexpected_proposal -> Some () | _ -> None)
    (fun () -> Unexpected_proposal) ;
  (* Unauthorized proposal *)
  register_error_kind
    `Branch
    ~id:"unauthorized_proposal"
    ~title:"Unauthorized proposal"
    ~description:
      "The delegate provided for the proposal is not in the voting listings."
    ~pp:(fun ppf () -> Format.fprintf ppf "Unauthorized proposal")
    empty
    (function Unauthorized_proposal -> Some () | _ -> None)
    (fun () -> Unauthorized_proposal) ;
  (* Unexpected ballot *)
  register_error_kind
    `Branch
    ~id:"unexpected_ballot"
    ~title:"Unexpected ballot"
    ~description:"Ballot recorded outside of a voting period."
    ~pp:(fun ppf () -> Format.fprintf ppf "Unexpected ballot")
    empty
    (function Unexpected_ballot -> Some () | _ -> None)
    (fun () -> Unexpected_ballot) ;
  (* Unauthorized ballot *)
  register_error_kind
    `Branch
    ~id:"unauthorized_ballot"
    ~title:"Unauthorized ballot"
    ~description:
      "The delegate provided for the ballot is not in the voting listings."
    ~pp:(fun ppf () -> Format.fprintf ppf "Unauthorized ballot")
    empty
    (function Unauthorized_ballot -> Some () | _ -> None)
    (fun () -> Unauthorized_ballot) ;
  (* Too many proposals *)
  register_error_kind
    `Branch
    ~id:"too_many_proposals"
    ~title:"Too many proposals"
    ~description:
      "The delegate reached the maximum number of allowed proposals."
    ~pp:(fun ppf () -> Format.fprintf ppf "Too many proposals")
    empty
    (function Too_many_proposals -> Some () | _ -> None)
    (fun () -> Too_many_proposals) ;
  (* Empty proposal *)
  register_error_kind
    `Branch
    ~id:"empty_proposal"
    ~title:"Empty proposal"
    ~description:"Proposal lists cannot be empty."
    ~pp:(fun ppf () -> Format.fprintf ppf "Empty proposal")
    empty
    (function Empty_proposal -> Some () | _ -> None)
    (fun () -> Empty_proposal)

(* @return [true] if [List.length l] > [n] w/o computing length *)
let rec longer_than l n =
  if Compare.Int.(n < 0) then assert false
  else
    match l with
    | [] ->
        false
    | _ :: rest ->
        if Compare.Int.(n = 0) then true
        else (* n > 0 *)
          longer_than rest (n - 1)

let record_proposals ctxt delegate proposals =
  (match proposals with [] -> fail Empty_proposal | _ :: _ -> return_unit)
  >>=? fun () ->
  Vote.get_current_period_kind ctxt
  >>=? function
  | Proposal ->
      Vote.in_listings ctxt delegate
      >>= fun in_listings ->
      if in_listings then
        Vote.recorded_proposal_count_for_delegate ctxt delegate
        >>=? fun count ->
        fail_when
          (longer_than proposals (Constants.max_proposals_per_delegate - count))
          Too_many_proposals
        >>=? fun () ->
        fold_left_s
          (fun ctxt proposal -> Vote.record_proposal ctxt proposal delegate)
          ctxt
          proposals
        >>=? fun ctxt -> return ctxt
      else fail Unauthorized_proposal
  | Testing_vote | Testing | Promotion_vote ->
      fail Unexpected_proposal

let record_ballot ctxt delegate proposal ballot =
  Vote.get_current_period_kind ctxt
  >>=? function
  | Testing_vote | Promotion_vote ->
      Vote.get_current_proposal ctxt
      >>=? fun current_proposal ->
      fail_unless
        (Protocol_hash.equal proposal current_proposal)
        Invalid_proposal
      >>=? fun () ->
      Vote.has_recorded_ballot ctxt delegate
      >>= fun has_ballot ->
      fail_when has_ballot Unauthorized_ballot
      >>=? fun () ->
      Vote.in_listings ctxt delegate
      >>= fun in_listings ->
      if in_listings then Vote.record_ballot ctxt delegate ballot
      else fail Unauthorized_ballot
  | Testing | Proposal ->
      fail Unexpected_ballot

let last_of_a_voting_period ctxt l =
  Compare.Int32.(
    Int32.succ l.Level.voting_period_position
    = Constants.blocks_per_voting_period ctxt)

let may_start_new_voting_period ctxt =
  let level = Level.current ctxt in
  if last_of_a_voting_period ctxt level then start_new_voting_period ctxt
  else return ctxt

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Import Alpha_context.

Definition select_winning_proposal
  (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (option
        Tezos_protocol_environment_alpha__Environment.Protocol_hash.Map.key)) :=
  op_gtgteqquestion (Vote.get_proposals ctxt)
    (fun proposals =>
      let merge {A : Set}
        (proposal : A) (vote :
        Tezos_protocol_environment_alpha__Environment.Compare.Int32.t) (winners
        :
        option
          (list A *
            Tezos_protocol_environment_alpha__Environment.Compare.Int32.t))
        : option
          (list A *
            Tezos_protocol_environment_alpha__Environment.Compare.Int32.t) :=
        match winners with
        | None => Some ((cons proposal []), vote)
        | (Some (winners, winners_vote)) as previous =>
          if op_eq vote winners_vote then
            Some ((cons proposal winners), winners_vote)
          else
            if op_gt vote winners_vote then
              Some ((cons proposal []), vote)
            else
              previous
        end in
      match Protocol_hash.Map.fold merge proposals None with
      | Some (cons proposal [], vote) =>
        op_gtgteqquestion (Vote.listing_size ctxt)
          (fun max_vote =>
            let min_proposal_quorum := Constants.min_proposal_quorum ctxt in
            let min_vote_to_pass :=
              Int32.div (Int32.mul min_proposal_quorum max_vote)
                (* ❌ Constant of type int32 is converted to int *)
                10000 in
            if op_gteq vote min_vote_to_pass then
              return_some proposal
            else
              return_none)
      | _ => return_none
      end).

Definition check_approval_and_update_participation_ema
  (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha__Alpha_context.context * bool)) :=
  op_gtgteqquestion (Vote.get_ballots ctxt)
    (fun ballots =>
      op_gtgteqquestion (Vote.listing_size ctxt)
        (fun maximum_vote =>
          op_gtgteqquestion (Vote.get_participation_ema ctxt)
            (fun participation_ema =>
              op_gtgteqquestion (Vote.get_current_quorum ctxt)
                (fun expected_quorum =>
                  let casted_votes :=
                    Int32.add
                      (Tezos_raw_protocol_alpha.Alpha_context.Vote.ballots.yay
                        ballots)
                      (Tezos_raw_protocol_alpha.Alpha_context.Vote.ballots.nay
                        ballots) in
                  let all_votes :=
                    Int32.add casted_votes
                      (Tezos_raw_protocol_alpha.Alpha_context.Vote.ballots.pass
                        ballots) in
                  let supermajority :=
                    Int32.div
                      (Int32.mul
                        (* ❌ Constant of type int32 is converted to int *)
                        8 casted_votes)
                      (* ❌ Constant of type int32 is converted to int *)
                      10 in
                  let participation :=
                    to_int32
                      (div
                        (mul (of_int32 all_votes)
                          (* ❌ Constant of type int64 is converted to int *)
                          10000) (of_int32 maximum_vote)) in
                  let outcome :=
                    op_andand (op_gteq participation expected_quorum)
                      (op_gteq
                        (Tezos_raw_protocol_alpha.Alpha_context.Vote.ballots.yay
                          ballots) supermajority) in
                  let new_participation_ema :=
                    div
                      (add
                        (mul
                          (* ❌ Constant of type int32 is converted to int *)
                          8 participation_ema)
                        (mul
                          (* ❌ Constant of type int32 is converted to int *)
                          2 participation))
                      (* ❌ Constant of type int32 is converted to int *)
                      10 in
                  op_gtgteqquestion
                    (Vote.set_participation_ema ctxt new_participation_ema)
                    (fun ctxt => __return (ctxt, outcome)))))).

Definition start_new_voting_period
  (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha__Alpha_context.context) :=
  op_gtgteqquestion (Vote.get_current_period_kind ctxt)
    (fun function_parameter =>
      match function_parameter with
      | Tezos_raw_protocol_alpha__Alpha_context.Voting_period.Proposal =>
        op_gtgteqquestion (select_winning_proposal ctxt)
          (fun proposal =>
            op_gtgteq (Vote.clear_proposals ctxt)
              (fun ctxt =>
                op_gtgteqquestion (Vote.clear_listings ctxt)
                  (fun ctxt =>
                    match proposal with
                    | None =>
                      op_gtgteqquestion (Vote.freeze_listings ctxt)
                        (fun ctxt => __return ctxt)
                    | Some proposal =>
                      op_gtgteqquestion
                        (Vote.init_current_proposal ctxt proposal)
                        (fun ctxt =>
                          op_gtgteqquestion (Vote.freeze_listings ctxt)
                            (fun ctxt =>
                              op_gtgteqquestion
                                (Vote.set_current_period_kind ctxt
                                  Tezos_raw_protocol_alpha__Alpha_context.Voting_period.Testing_vote)
                                (fun ctxt => __return ctxt)))
                    end)))
      | Tezos_raw_protocol_alpha__Alpha_context.Voting_period.Testing_vote =>
        op_gtgteqquestion (check_approval_and_update_participation_ema ctxt)
          (fun function_parameter =>
            let '(ctxt, approved) := function_parameter in
            op_gtgteq (Vote.clear_ballots ctxt)
              (fun ctxt =>
                op_gtgteqquestion (Vote.clear_listings ctxt)
                  (fun ctxt =>
                    if approved then
                      let expiration :=
                        Time.add (Timestamp.current ctxt)
                          (Constants.test_chain_duration ctxt) in
                      op_gtgteqquestion (Vote.get_current_proposal ctxt)
                        (fun proposal =>
                          op_gtgteq (fork_test_chain ctxt proposal expiration)
                            (fun ctxt =>
                              op_gtgteqquestion
                                (Vote.set_current_period_kind ctxt
                                  Tezos_raw_protocol_alpha__Alpha_context.Voting_period.Testing)
                                (fun ctxt => __return ctxt)))
                    else
                      op_gtgteqquestion (Vote.clear_current_proposal ctxt)
                        (fun ctxt =>
                          op_gtgteqquestion (Vote.freeze_listings ctxt)
                            (fun ctxt =>
                              op_gtgteqquestion
                                (Vote.set_current_period_kind ctxt
                                  Tezos_raw_protocol_alpha__Alpha_context.Voting_period.Proposal)
                                (fun ctxt => __return ctxt))))))
      | Tezos_raw_protocol_alpha__Alpha_context.Voting_period.Testing =>
        op_gtgteqquestion (Vote.freeze_listings ctxt)
          (fun ctxt =>
            op_gtgteqquestion
              (Vote.set_current_period_kind ctxt
                Tezos_raw_protocol_alpha__Alpha_context.Voting_period.Promotion_vote)
              (fun ctxt => __return ctxt))
      | Tezos_raw_protocol_alpha__Alpha_context.Voting_period.Promotion_vote =>
        op_gtgteqquestion (check_approval_and_update_participation_ema ctxt)
          (fun function_parameter =>
            let '(ctxt, approved) := function_parameter in
            op_gtgteqquestion
              (if approved then
                op_gtgteqquestion (Vote.get_current_proposal ctxt)
                  (fun proposal =>
                    op_gtgteq (activate ctxt proposal)
                      (fun ctxt => __return ctxt))
              else
                __return ctxt)
              (fun ctxt =>
                op_gtgteq (Vote.clear_ballots ctxt)
                  (fun ctxt =>
                    op_gtgteqquestion (Vote.clear_listings ctxt)
                      (fun ctxt =>
                        op_gtgteqquestion (Vote.clear_current_proposal ctxt)
                          (fun ctxt =>
                            op_gtgteqquestion (Vote.freeze_listings ctxt)
                              (fun ctxt =>
                                op_gtgteqquestion
                                  (Vote.set_current_period_kind ctxt
                                    Tezos_raw_protocol_alpha__Alpha_context.Voting_period.Proposal)
                                  (fun ctxt => __return ctxt)))))))
      end).

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Top-level evaluations are considered as an error as sources of side-effects *)
Compute
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "invalid_proposal" % string "Invalid proposal" % string
      "Ballot provided for a proposal that is not the current one." % string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let 'tt := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Invalid proposal" % string
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
                "Invalid proposal" % string))) empty
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_proposal
          => Some tt
        | _ => None
        end)
      (fun function_parameter =>
        let 'tt := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_proposal)
    in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "unexpected_proposal" % string "Unexpected proposal" % string
      "Proposal recorded outside of a proposal period." % string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let 'tt := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Unexpected proposal" % string
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
                "Unexpected proposal" % string))) empty
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_proposal
          => Some tt
        | _ => None
        end)
      (fun function_parameter =>
        let 'tt := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_proposal)
    in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "unauthorized_proposal" % string "Unauthorized proposal" % string
      "The delegate provided for the proposal is not in the voting listings." %
        string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let 'tt := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Unauthorized proposal" % string
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
                "Unauthorized proposal" % string))) empty
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Unauthorized_proposal
          => Some tt
        | _ => None
        end)
      (fun function_parameter =>
        let 'tt := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Unauthorized_proposal)
    in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "unexpected_ballot" % string "Unexpected ballot" % string
      "Ballot recorded outside of a voting period." % string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let 'tt := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Unexpected ballot" % string
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
                "Unexpected ballot" % string))) empty
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_ballot
          => Some tt
        | _ => None
        end)
      (fun function_parameter =>
        let 'tt := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_ballot)
    in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "unauthorized_ballot" % string "Unauthorized ballot" % string
      "The delegate provided for the ballot is not in the voting listings." %
        string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let 'tt := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Unauthorized ballot" % string
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
                "Unauthorized ballot" % string))) empty
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Unauthorized_ballot
          => Some tt
        | _ => None
        end)
      (fun function_parameter =>
        let 'tt := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Unauthorized_ballot)
    in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "too_many_proposals" % string "Too many proposals" % string
      "The delegate reached the maximum number of allowed proposals." % string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let 'tt := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Too many proposals" % string
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
                "Too many proposals" % string))) empty
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Too_many_proposals
          => Some tt
        | _ => None
        end)
      (fun function_parameter =>
        let 'tt := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Too_many_proposals)
    in
  register_error_kind
    (* ❌ Variants not supported *)
    variant "empty_proposal" % string "Empty proposal" % string
    "Proposal lists cannot be empty." % string
    (Some
      (fun ppf =>
        fun function_parameter =>
          let 'tt := function_parameter in
          Format.fprintf ppf
            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                "Empty proposal" % string
                Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
              "Empty proposal" % string))) empty
    (fun function_parameter =>
      match function_parameter with
      | Tezos_protocol_environment_alpha__Environment.Error_monad.Empty_proposal
        => Some tt
      | _ => None
      end)
    (fun function_parameter =>
      let 'tt := function_parameter in
      Tezos_protocol_environment_alpha__Environment.Error_monad.Empty_proposal).

Fixpoint longer_than {A : Set}
  (l : list A) (n : Tezos_protocol_environment_alpha__Environment.Compare.Int.t)
  : bool :=
  if op_lt n 0 then
    (* ❌ Assert instruction is not handled. *)
    assert false
  else
    match l with
    | [] => false
    | cons _ rest =>
      if op_eq n 0 then
        true
      else
        longer_than rest (op_minus n 1)
    end.

Definition record_proposals
  (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
  (delegate : Tezos_raw_protocol_alpha__Alpha_context.public_key_hash)
  (proposals :
    list Tezos_protocol_environment_alpha__Environment.Protocol_hash.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha__Alpha_context.context) :=
  op_gtgteqquestion
    match proposals with
    | [] =>
      fail
        Tezos_protocol_environment_alpha__Environment.Error_monad.Empty_proposal
    | cons _ _ => return_unit
    end
    (fun function_parameter =>
      let 'tt := function_parameter in
      op_gtgteqquestion (Vote.get_current_period_kind ctxt)
        (fun function_parameter =>
          match function_parameter with
          | Tezos_raw_protocol_alpha__Alpha_context.Voting_period.Proposal =>
            op_gtgteq (Vote.in_listings ctxt delegate)
              (fun in_listings =>
                if in_listings then
                  op_gtgteqquestion
                    (Vote.recorded_proposal_count_for_delegate ctxt delegate)
                    (fun count =>
                      op_gtgteqquestion
                        (fail_when
                          (longer_than proposals
                            (op_minus Constants.max_proposals_per_delegate count))
                          Tezos_protocol_environment_alpha__Environment.Error_monad.Too_many_proposals)
                        (fun function_parameter =>
                          let 'tt := function_parameter in
                          op_gtgteqquestion
                            (fold_left_s
                              (fun ctxt =>
                                fun proposal =>
                                  Vote.record_proposal ctxt proposal delegate)
                              ctxt proposals) (fun ctxt => __return ctxt)))
                else
                  fail
                    Tezos_protocol_environment_alpha__Environment.Error_monad.Unauthorized_proposal)
          |
            Tezos_raw_protocol_alpha__Alpha_context.Voting_period.Testing_vote |
              Tezos_raw_protocol_alpha__Alpha_context.Voting_period.Testing |
              Tezos_raw_protocol_alpha__Alpha_context.Voting_period.Promotion_vote
            =>
            fail
              Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_proposal
          end)).

Definition record_ballot
  (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
  (delegate : Tezos_raw_protocol_alpha__Alpha_context.public_key_hash)
  (proposal : Tezos_protocol_environment_alpha__Environment.Protocol_hash.t)
  (ballot : Tezos_raw_protocol_alpha.Alpha_context.Vote.ballot)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha__Alpha_context.context) :=
  op_gtgteqquestion (Vote.get_current_period_kind ctxt)
    (fun function_parameter =>
      match function_parameter with
      |
        Tezos_raw_protocol_alpha__Alpha_context.Voting_period.Testing_vote |
          Tezos_raw_protocol_alpha__Alpha_context.Voting_period.Promotion_vote
        =>
        op_gtgteqquestion (Vote.get_current_proposal ctxt)
          (fun current_proposal =>
            op_gtgteqquestion
              (fail_unless (Protocol_hash.equal proposal current_proposal)
                Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_proposal)
              (fun function_parameter =>
                let 'tt := function_parameter in
                op_gtgteq (Vote.has_recorded_ballot ctxt delegate)
                  (fun has_ballot =>
                    op_gtgteqquestion
                      (fail_when has_ballot
                        Tezos_protocol_environment_alpha__Environment.Error_monad.Unauthorized_ballot)
                      (fun function_parameter =>
                        let 'tt := function_parameter in
                        op_gtgteq (Vote.in_listings ctxt delegate)
                          (fun in_listings =>
                            if in_listings then
                              Vote.record_ballot ctxt delegate ballot
                            else
                              fail
                                Tezos_protocol_environment_alpha__Environment.Error_monad.Unauthorized_ballot)))))
      |
        Tezos_raw_protocol_alpha__Alpha_context.Voting_period.Testing |
          Tezos_raw_protocol_alpha__Alpha_context.Voting_period.Proposal =>
        fail
          Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_ballot
      end).

Definition last_of_a_voting_period
  (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
  (l : Tezos_raw_protocol_alpha.Alpha_context.Level.t) : bool :=
  op_eq
    (Int32.succ
      (Tezos_raw_protocol_alpha.Alpha_context.Level.t.voting_period_position l))
    (Constants.blocks_per_voting_period ctxt).

Definition may_start_new_voting_period
  (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha__Alpha_context.context) :=
  let level := Level.current ctxt in
  if last_of_a_voting_period ctxt level then
    start_new_voting_period ctxt
  else
    __return ctxt.

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

(**
   Only delegates with at least one roll take part in the amendment procedure.
   It works as follows:
   - Proposal period: delegates can submit protocol amendment proposals using
     the proposal operation. At the end of a proposal period, the proposal with
     most supporters is selected and we move to a testing_vote period.
     If there are no proposals, or a tie between proposals, a new proposal
     period starts.
   - Testing_vote period: delegates can cast votes to test or not the winning
     proposal using the ballot operation.
     At the end of a testing_vote period if participation reaches the quorum
     and the proposal has a supermajority in favor, we proceed to a testing
     period. Otherwise we go back to a proposal period.
     In any case, if there is enough participation the quorum is updated.
   - Testing period: a test chain is forked for the lengh of the period.
     At the end of a testing period we move to a promotion_vote period.
   - Promotion_vote period: delegates can cast votes to promote or not the
     tested proposal using the ballot operation.
     At the end of a promotion_vote period if participation reaches the quorum
     and the tested proposal has a supermajority in favor, it is activated as
     the new protocol. Otherwise we go back to a proposal period.
     In any case, if there is enough participation the quorum is updated.
*)

open Alpha_context

(** If at the end of a voting period, moves to the next one following
    the state machine of the amendment procedure. *)
val may_start_new_voting_period : context -> context tzresult Lwt.t

type error +=
  | Unexpected_proposal
  | Unauthorized_proposal
  | Too_many_proposals
  | Empty_proposal

(** Records a list of proposals for a delegate.
    @raise Unexpected_proposal if [ctxt] is not in a proposal period.
    @raise Unauthorized_proposal if [delegate] is not in the listing. *)
val record_proposals :
  context -> public_key_hash -> Protocol_hash.t list -> context tzresult Lwt.t

type error += Invalid_proposal | Unexpected_ballot | Unauthorized_ballot

val record_ballot :
  context ->
  public_key_hash ->
  Protocol_hash.t ->
  Vote.ballot ->
  context tzresult Lwt.t

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Parameter may_start_new_voting_period :
  Tezos_raw_protocol_alpha.Alpha_context.context ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Alpha_context.context).

(* extensible_type Tezos_protocol_environment_alpha__Environment.Error_monad.error *)

Parameter record_proposals :
  Tezos_raw_protocol_alpha.Alpha_context.context ->
  Tezos_raw_protocol_alpha.Alpha_context.public_key_hash ->
  list Tezos_protocol_environment_alpha__Environment.Protocol_hash.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Alpha_context.context).

(* extensible_type Tezos_protocol_environment_alpha__Environment.Error_monad.error *)

Parameter record_ballot :
  Tezos_raw_protocol_alpha.Alpha_context.context ->
  Tezos_raw_protocol_alpha.Alpha_context.public_key_hash ->
  Tezos_protocol_environment_alpha__Environment.Protocol_hash.t ->
  Tezos_raw_protocol_alpha.Alpha_context.Vote.ballot ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Alpha_context.context).

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

(** Tezos Protocol Implementation - Main Entry Points *)

open Alpha_context

type error += Wrong_voting_period of Voting_period.t * Voting_period.t

(* `Temporary *)

type error += Wrong_endorsement_predecessor of Block_hash.t * Block_hash.t

(* `Temporary *)

type error += Duplicate_endorsement of Signature.Public_key_hash.t

(* `Branch *)

type error += Invalid_endorsement_level

type error += Invalid_commitment of {expected : bool}

type error += Internal_operation_replay of packed_internal_operation

type error += Invalid_double_endorsement_evidence (* `Permanent *)

type error +=
  | Inconsistent_double_endorsement_evidence of {
      delegate1 : Signature.Public_key_hash.t;
      delegate2 : Signature.Public_key_hash.t;
    }

(* `Permanent *)

type error += Unrequired_double_endorsement_evidence (* `Branch*)

type error +=
  | Too_early_double_endorsement_evidence of {
      level : Raw_level.t;
      current : Raw_level.t;
    }

(* `Temporary *)

type error +=
  | Outdated_double_endorsement_evidence of {
      level : Raw_level.t;
      last : Raw_level.t;
    }

(* `Permanent *)

type error +=
  | Invalid_double_baking_evidence of {
      hash1 : Block_hash.t;
      level1 : Int32.t;
      hash2 : Block_hash.t;
      level2 : Int32.t;
    }

(* `Permanent *)

type error +=
  | Inconsistent_double_baking_evidence of {
      delegate1 : Signature.Public_key_hash.t;
      delegate2 : Signature.Public_key_hash.t;
    }

(* `Permanent *)

type error += Unrequired_double_baking_evidence (* `Branch*)

type error +=
  | Too_early_double_baking_evidence of {
      level : Raw_level.t;
      current : Raw_level.t;
    }

(* `Temporary *)

type error +=
  | Outdated_double_baking_evidence of {
      level : Raw_level.t;
      last : Raw_level.t;
    }

(* `Permanent *)

type error += Invalid_activation of {pkh : Ed25519.Public_key_hash.t}

type error += Multiple_revelation

type error += Gas_quota_exceeded_init_deserialize (* Permanent *)

type error +=
  | Not_enough_endorsements_for_priority of {
      required : int;
      priority : int;
      endorsements : int;
      timestamp : Time.t;
    }

let () =
  register_error_kind
    `Temporary
    ~id:"operation.wrong_endorsement_predecessor"
    ~title:"Wrong endorsement predecessor"
    ~description:
      "Trying to include an endorsement in a block that is not the successor \
       of the endorsed one"
    ~pp:(fun ppf (e, p) ->
      Format.fprintf
        ppf
        "Wrong predecessor %a, expected %a"
        Block_hash.pp
        p
        Block_hash.pp
        e)
    Data_encoding.(
      obj2
        (req "expected" Block_hash.encoding)
        (req "provided" Block_hash.encoding))
    (function
      | Wrong_endorsement_predecessor (e, p) -> Some (e, p) | _ -> None)
    (fun (e, p) -> Wrong_endorsement_predecessor (e, p)) ;
  register_error_kind
    `Temporary
    ~id:"operation.wrong_voting_period"
    ~title:"Wrong voting period"
    ~description:
      "Trying to onclude a proposal or ballot meant for another voting period"
    ~pp:(fun ppf (e, p) ->
      Format.fprintf
        ppf
        "Wrong voting period %a, current is %a"
        Voting_period.pp
        p
        Voting_period.pp
        e)
    Data_encoding.(
      obj2
        (req "current" Voting_period.encoding)
        (req "provided" Voting_period.encoding))
    (function Wrong_voting_period (e, p) -> Some (e, p) | _ -> None)
    (fun (e, p) -> Wrong_voting_period (e, p)) ;
  register_error_kind
    `Branch
    ~id:"operation.duplicate_endorsement"
    ~title:"Duplicate endorsement"
    ~description:"Two endorsements received from same delegate"
    ~pp:(fun ppf k ->
      Format.fprintf
        ppf
        "Duplicate endorsement from delegate %a (possible replay attack)."
        Signature.Public_key_hash.pp_short
        k)
    Data_encoding.(obj1 (req "delegate" Signature.Public_key_hash.encoding))
    (function Duplicate_endorsement k -> Some k | _ -> None)
    (fun k -> Duplicate_endorsement k) ;
  register_error_kind
    `Temporary
    ~id:"operation.invalid_endorsement_level"
    ~title:"Unexpected level in endorsement"
    ~description:
      "The level of an endorsement is inconsistent with the  provided block \
       hash."
    ~pp:(fun ppf () -> Format.fprintf ppf "Unexpected level in endorsement.")
    Data_encoding.unit
    (function Invalid_endorsement_level -> Some () | _ -> None)
    (fun () -> Invalid_endorsement_level) ;
  register_error_kind
    `Permanent
    ~id:"block.invalid_commitment"
    ~title:"Invalid commitment in block header"
    ~description:"The block header has invalid commitment."
    ~pp:(fun ppf expected ->
      if expected then
        Format.fprintf ppf "Missing seed's nonce commitment in block header."
      else
        Format.fprintf
          ppf
          "Unexpected seed's nonce commitment in block header.")
    Data_encoding.(obj1 (req "expected" bool))
    (function Invalid_commitment {expected} -> Some expected | _ -> None)
    (fun expected -> Invalid_commitment {expected}) ;
  register_error_kind
    `Permanent
    ~id:"internal_operation_replay"
    ~title:"Internal operation replay"
    ~description:"An internal operation was emitted twice by a script"
    ~pp:(fun ppf (Internal_operation {nonce; _}) ->
      Format.fprintf
        ppf
        "Internal operation %d was emitted twice by a script"
        nonce)
    Operation.internal_operation_encoding
    (function Internal_operation_replay op -> Some op | _ -> None)
    (fun op -> Internal_operation_replay op) ;
  register_error_kind
    `Permanent
    ~id:"block.invalid_double_endorsement_evidence"
    ~title:"Invalid double endorsement evidence"
    ~description:"A double-endorsement evidence is malformed"
    ~pp:(fun ppf () ->
      Format.fprintf ppf "Malformed double-endorsement evidence")
    Data_encoding.empty
    (function Invalid_double_endorsement_evidence -> Some () | _ -> None)
    (fun () -> Invalid_double_endorsement_evidence) ;
  register_error_kind
    `Permanent
    ~id:"block.inconsistent_double_endorsement_evidence"
    ~title:"Inconsistent double endorsement evidence"
    ~description:
      "A double-endorsement evidence is inconsistent  (two distinct delegates)"
    ~pp:(fun ppf (delegate1, delegate2) ->
      Format.fprintf
        ppf
        "Inconsistent double-endorsement evidence  (distinct delegate: %a and \
         %a)"
        Signature.Public_key_hash.pp_short
        delegate1
        Signature.Public_key_hash.pp_short
        delegate2)
    Data_encoding.(
      obj2
        (req "delegate1" Signature.Public_key_hash.encoding)
        (req "delegate2" Signature.Public_key_hash.encoding))
    (function
      | Inconsistent_double_endorsement_evidence {delegate1; delegate2} ->
          Some (delegate1, delegate2)
      | _ ->
          None)
    (fun (delegate1, delegate2) ->
      Inconsistent_double_endorsement_evidence {delegate1; delegate2}) ;
  register_error_kind
    `Branch
    ~id:"block.unrequired_double_endorsement_evidence"
    ~title:"Unrequired double endorsement evidence"
    ~description:"A double-endorsement evidence is unrequired"
    ~pp:(fun ppf () ->
      Format.fprintf
        ppf
        "A valid double-endorsement operation cannot  be applied: the \
         associated delegate  has previously been denunciated in this cycle.")
    Data_encoding.empty
    (function Unrequired_double_endorsement_evidence -> Some () | _ -> None)
    (fun () -> Unrequired_double_endorsement_evidence) ;
  register_error_kind
    `Temporary
    ~id:"block.too_early_double_endorsement_evidence"
    ~title:"Too early double endorsement evidence"
    ~description:"A double-endorsement evidence is in the future"
    ~pp:(fun ppf (level, current) ->
      Format.fprintf
        ppf
        "A double-endorsement evidence is in the future  (current level: %a, \
         endorsement level: %a)"
        Raw_level.pp
        current
        Raw_level.pp
        level)
    Data_encoding.(
      obj2 (req "level" Raw_level.encoding) (req "current" Raw_level.encoding))
    (function
      | Too_early_double_endorsement_evidence {level; current} ->
          Some (level, current)
      | _ ->
          None)
    (fun (level, current) ->
      Too_early_double_endorsement_evidence {level; current}) ;
  register_error_kind
    `Permanent
    ~id:"block.outdated_double_endorsement_evidence"
    ~title:"Outdated double endorsement evidence"
    ~description:"A double-endorsement evidence is outdated."
    ~pp:(fun ppf (level, last) ->
      Format.fprintf
        ppf
        "A double-endorsement evidence is outdated  (last acceptable level: \
         %a, endorsement level: %a)"
        Raw_level.pp
        last
        Raw_level.pp
        level)
    Data_encoding.(
      obj2 (req "level" Raw_level.encoding) (req "last" Raw_level.encoding))
    (function
      | Outdated_double_endorsement_evidence {level; last} ->
          Some (level, last)
      | _ ->
          None)
    (fun (level, last) -> Outdated_double_endorsement_evidence {level; last}) ;
  register_error_kind
    `Permanent
    ~id:"block.invalid_double_baking_evidence"
    ~title:"Invalid double baking evidence"
    ~description:
      "A double-baking evidence is inconsistent  (two distinct level)"
    ~pp:(fun ppf (hash1, level1, hash2, level2) ->
      Format.fprintf
        ppf
        "Invalid double-baking evidence (hash: %a and %a, levels: %ld and %ld)"
        Block_hash.pp
        hash1
        Block_hash.pp
        hash2
        level1
        level2)
    Data_encoding.(
      obj4
        (req "hash1" Block_hash.encoding)
        (req "level1" int32)
        (req "hash2" Block_hash.encoding)
        (req "level2" int32))
    (function
      | Invalid_double_baking_evidence {hash1; level1; hash2; level2} ->
          Some (hash1, level1, hash2, level2)
      | _ ->
          None)
    (fun (hash1, level1, hash2, level2) ->
      Invalid_double_baking_evidence {hash1; level1; hash2; level2}) ;
  register_error_kind
    `Permanent
    ~id:"block.inconsistent_double_baking_evidence"
    ~title:"Inconsistent double baking evidence"
    ~description:
      "A double-baking evidence is inconsistent  (two distinct delegates)"
    ~pp:(fun ppf (delegate1, delegate2) ->
      Format.fprintf
        ppf
        "Inconsistent double-baking evidence  (distinct delegate: %a and %a)"
        Signature.Public_key_hash.pp_short
        delegate1
        Signature.Public_key_hash.pp_short
        delegate2)
    Data_encoding.(
      obj2
        (req "delegate1" Signature.Public_key_hash.encoding)
        (req "delegate2" Signature.Public_key_hash.encoding))
    (function
      | Inconsistent_double_baking_evidence {delegate1; delegate2} ->
          Some (delegate1, delegate2)
      | _ ->
          None)
    (fun (delegate1, delegate2) ->
      Inconsistent_double_baking_evidence {delegate1; delegate2}) ;
  register_error_kind
    `Branch
    ~id:"block.unrequired_double_baking_evidence"
    ~title:"Unrequired double baking evidence"
    ~description:"A double-baking evidence is unrequired"
    ~pp:(fun ppf () ->
      Format.fprintf
        ppf
        "A valid double-baking operation cannot  be applied: the associated \
         delegate  has previously been denunciated in this cycle.")
    Data_encoding.empty
    (function Unrequired_double_baking_evidence -> Some () | _ -> None)
    (fun () -> Unrequired_double_baking_evidence) ;
  register_error_kind
    `Temporary
    ~id:"block.too_early_double_baking_evidence"
    ~title:"Too early double baking evidence"
    ~description:"A double-baking evidence is in the future"
    ~pp:(fun ppf (level, current) ->
      Format.fprintf
        ppf
        "A double-baking evidence is in the future  (current level: %a, \
         baking level: %a)"
        Raw_level.pp
        current
        Raw_level.pp
        level)
    Data_encoding.(
      obj2 (req "level" Raw_level.encoding) (req "current" Raw_level.encoding))
    (function
      | Too_early_double_baking_evidence {level; current} ->
          Some (level, current)
      | _ ->
          None)
    (fun (level, current) -> Too_early_double_baking_evidence {level; current}) ;
  register_error_kind
    `Permanent
    ~id:"block.outdated_double_baking_evidence"
    ~title:"Outdated double baking evidence"
    ~description:"A double-baking evidence is outdated."
    ~pp:(fun ppf (level, last) ->
      Format.fprintf
        ppf
        "A double-baking evidence is outdated  (last acceptable level: %a, \
         baking level: %a)"
        Raw_level.pp
        last
        Raw_level.pp
        level)
    Data_encoding.(
      obj2 (req "level" Raw_level.encoding) (req "last" Raw_level.encoding))
    (function
      | Outdated_double_baking_evidence {level; last} ->
          Some (level, last)
      | _ ->
          None)
    (fun (level, last) -> Outdated_double_baking_evidence {level; last}) ;
  register_error_kind
    `Permanent
    ~id:"operation.invalid_activation"
    ~title:"Invalid activation"
    ~description:
      "The given key and secret do not correspond to any existing \
       preallocated contract"
    ~pp:(fun ppf pkh ->
      Format.fprintf
        ppf
        "Invalid activation. The public key %a does not match any commitment."
        Ed25519.Public_key_hash.pp
        pkh)
    Data_encoding.(obj1 (req "pkh" Ed25519.Public_key_hash.encoding))
    (function Invalid_activation {pkh} -> Some pkh | _ -> None)
    (fun pkh -> Invalid_activation {pkh}) ;
  register_error_kind
    `Permanent
    ~id:"block.multiple_revelation"
    ~title:"Multiple revelations were included in a manager operation"
    ~description:
      "A manager operation should not contain more than one revelation"
    ~pp:(fun ppf () ->
      Format.fprintf
        ppf
        "Multiple revelations were included in a manager operation")
    Data_encoding.empty
    (function Multiple_revelation -> Some () | _ -> None)
    (fun () -> Multiple_revelation) ;
  register_error_kind
    `Permanent
    ~id:"gas_exhausted.init_deserialize"
    ~title:"Not enough gas for initial deserialization of script expresions"
    ~description:
      "Gas limit was not high enough to deserialize the transaction \
       parameters or origination script code or initial storage, making the \
       operation impossible to parse within the provided gas bounds."
    Data_encoding.empty
    (function Gas_quota_exceeded_init_deserialize -> Some () | _ -> None)
    (fun () -> Gas_quota_exceeded_init_deserialize) ;
  register_error_kind
    `Permanent
    ~id:"operation.not_enought_endorsements_for_priority"
    ~title:"Not enough endorsements for priority"
    ~description:
      "The block being validated does not include the required minimum number \
       of endorsements for this priority."
    ~pp:(fun ppf (required, endorsements, priority, timestamp) ->
      Format.fprintf
        ppf
        "Wrong number of endorsements (%i) for priority (%i), %i are expected \
         at %a"
        endorsements
        priority
        required
        Time.pp_hum
        timestamp)
    Data_encoding.(
      obj4
        (req "required" int31)
        (req "endorsements" int31)
        (req "priority" int31)
        (req "timestamp" Time.encoding))
    (function
      | Not_enough_endorsements_for_priority
          {required; endorsements; priority; timestamp} ->
          Some (required, endorsements, priority, timestamp)
      | _ ->
          None)
    (fun (required, endorsements, priority, timestamp) ->
      Not_enough_endorsements_for_priority
        {required; endorsements; priority; timestamp})

open Apply_results

let apply_manager_operation_content :
    type kind.
    Alpha_context.t ->
    Script_ir_translator.unparsing_mode ->
    payer:Contract.t ->
    source:Contract.t ->
    chain_id:Chain_id.t ->
    internal:bool ->
    kind manager_operation ->
    ( context
    * kind successful_manager_operation_result
    * packed_internal_operation list )
    tzresult
    Lwt.t =
 fun ctxt mode ~payer ~source ~chain_id ~internal operation ->
  let before_operation =
    (* This context is not used for backtracking. Only to compute
         gas consumption and originations for the operation result. *)
    ctxt
  in
  Contract.must_exist ctxt source
  >>=? fun () ->
  Lwt.return (Gas.consume ctxt Michelson_v1_gas.Cost_of.manager_operation)
  >>=? fun ctxt ->
  match operation with
  | Reveal _ ->
      return
        (* No-op: action already performed by `precheck_manager_contents`. *)
        ( ctxt,
          ( Reveal_result
              {consumed_gas = Gas.consumed ~since:before_operation ~until:ctxt}
            : kind successful_manager_operation_result ),
          [] )
  | Transaction {amount; parameters; destination; entrypoint} -> (
      Contract.spend ctxt source amount
      >>=? fun ctxt ->
      ( match Contract.is_implicit destination with
      | None ->
          return (ctxt, [], false)
      | Some _ -> (
          Contract.allocated ctxt destination
          >>=? function
          | true ->
              return (ctxt, [], false)
          | false ->
              Fees.origination_burn ctxt
              >>=? fun (ctxt, origination_burn) ->
              return
                ( ctxt,
                  [(Delegate.Contract payer, Delegate.Debited origination_burn)],
                  true ) ) )
      >>=? fun (ctxt, maybe_burn_balance_update, allocated_destination_contract)
               ->
      Contract.credit ctxt destination amount
      >>=? fun ctxt ->
      Contract.get_script ctxt destination
      >>=? fun (ctxt, script) ->
      match script with
      | None ->
          ( match entrypoint with
          | "default" ->
              return ()
          | entrypoint ->
              fail (Script_tc_errors.No_such_entrypoint entrypoint) )
          >>=? (fun () ->
                 Script.force_decode ctxt parameters
                 >>=? fun (arg, ctxt) ->
                 (* see [note] *)
                 (* [note]: for toplevel ops, cost is nil since the
               lazy value has already been forced at precheck, so
               we compute and consume the full cost again *)
                 let cost_arg = Script.deserialized_cost arg in
                 Lwt.return (Gas.consume ctxt cost_arg)
                 >>=? fun ctxt ->
                 match Micheline.root arg with
                 | Prim (_, D_Unit, [], _) ->
                     (* Allow [Unit] parameter to non-scripted contracts. *)
                     return ctxt
                 | _ ->
                     fail
                       (Script_interpreter.Bad_contract_parameter destination))
          >>=? fun ctxt ->
          let result =
            Transaction_result
              {
                storage = None;
                big_map_diff = None;
                balance_updates =
                  Delegate.cleanup_balance_updates
                    ( [ (Delegate.Contract source, Delegate.Debited amount);
                        (Contract destination, Credited amount) ]
                    @ maybe_burn_balance_update );
                originated_contracts = [];
                consumed_gas = Gas.consumed ~since:before_operation ~until:ctxt;
                storage_size = Z.zero;
                paid_storage_size_diff = Z.zero;
                allocated_destination_contract;
              }
          in
          return (ctxt, result, [])
      | Some script ->
          Script.force_decode ctxt parameters
          >>=? fun (parameter, ctxt) ->
          (* see [note] *)
          let cost_parameter = Script.deserialized_cost parameter in
          Lwt.return (Gas.consume ctxt cost_parameter)
          >>=? fun ctxt ->
          let step_constants =
            let open Script_interpreter in
            {source; payer; self = destination; amount; chain_id}
          in
          Script_interpreter.execute
            ctxt
            mode
            step_constants
            ~script
            ~parameter
            ~entrypoint
          >>=? fun {ctxt; storage; big_map_diff; operations} ->
          Contract.update_script_storage ctxt destination storage big_map_diff
          >>=? fun ctxt ->
          Fees.record_paid_storage_space ctxt destination
          >>=? fun (ctxt, new_size, paid_storage_size_diff, fees) ->
          Contract.originated_from_current_nonce
            ~since:before_operation
            ~until:ctxt
          >>=? fun originated_contracts ->
          let result =
            Transaction_result
              {
                storage = Some storage;
                big_map_diff;
                balance_updates =
                  Delegate.cleanup_balance_updates
                    [ (Contract payer, Debited fees);
                      (Contract source, Debited amount);
                      (Contract destination, Credited amount) ];
                originated_contracts;
                consumed_gas = Gas.consumed ~since:before_operation ~until:ctxt;
                storage_size = new_size;
                paid_storage_size_diff;
                allocated_destination_contract;
              }
          in
          return (ctxt, result, operations) )
  | Origination {delegate; script; preorigination; credit} ->
      Script.force_decode ctxt script.storage
      >>=? fun (unparsed_storage, ctxt) ->
      (* see [note] *)
      Lwt.return (Gas.consume ctxt (Script.deserialized_cost unparsed_storage))
      >>=? fun ctxt ->
      Script.force_decode ctxt script.code
      >>=? fun (unparsed_code, ctxt) ->
      (* see [note] *)
      Lwt.return (Gas.consume ctxt (Script.deserialized_cost unparsed_code))
      >>=? fun ctxt ->
      Script_ir_translator.parse_script ctxt ~legacy:false script
      >>=? fun (Ex_script parsed_script, ctxt) ->
      Script_ir_translator.collect_big_maps
        ctxt
        parsed_script.storage_type
        parsed_script.storage
      >>=? fun (to_duplicate, ctxt) ->
      let to_update = Script_ir_translator.no_big_map_id in
      Script_ir_translator.extract_big_map_diff
        ctxt
        Optimized
        parsed_script.storage_type
        parsed_script.storage
        ~to_duplicate
        ~to_update
        ~temporary:false
      >>=? fun (storage, big_map_diff, ctxt) ->
      Script_ir_translator.unparse_data
        ctxt
        Optimized
        parsed_script.storage_type
        storage
      >>=? fun (storage, ctxt) ->
      let storage = Script.lazy_expr (Micheline.strip_locations storage) in
      let script = {script with storage} in
      Contract.spend ctxt source credit
      >>=? fun ctxt ->
      ( match preorigination with
      | Some contract ->
          assert internal ;
          (* The preorigination field is only used to early return
                 the address of an originated contract in Michelson.
                 It cannot come from the outside. *)
          return (ctxt, contract)
      | None ->
          Contract.fresh_contract_from_current_nonce ctxt )
      >>=? fun (ctxt, contract) ->
      Contract.originate
        ctxt
        contract
        ~delegate
        ~balance:credit
        ~script:(script, big_map_diff)
      >>=? fun ctxt ->
      Fees.origination_burn ctxt
      >>=? fun (ctxt, origination_burn) ->
      Fees.record_paid_storage_space ctxt contract
      >>=? fun (ctxt, size, paid_storage_size_diff, fees) ->
      let result =
        Origination_result
          {
            big_map_diff;
            balance_updates =
              Delegate.cleanup_balance_updates
                [ (Contract payer, Debited fees);
                  (Contract payer, Debited origination_burn);
                  (Contract source, Debited credit);
                  (Contract contract, Credited credit) ];
            originated_contracts = [contract];
            consumed_gas = Gas.consumed ~since:before_operation ~until:ctxt;
            storage_size = size;
            paid_storage_size_diff;
          }
      in
      return (ctxt, result, [])
  | Delegation delegate ->
      Delegate.set ctxt source delegate
      >>=? fun ctxt ->
      return
        ( ctxt,
          Delegation_result
            {consumed_gas = Gas.consumed ~since:before_operation ~until:ctxt},
          [] )

let apply_internal_manager_operations ctxt mode ~payer ~chain_id ops =
  let rec apply ctxt applied worklist =
    match worklist with
    | [] ->
        Lwt.return (`Success ctxt, List.rev applied)
    | Internal_operation ({source; operation; nonce} as op) :: rest -> (
        ( if internal_nonce_already_recorded ctxt nonce then
          fail (Internal_operation_replay (Internal_operation op))
        else
          let ctxt = record_internal_nonce ctxt nonce in
          apply_manager_operation_content
            ctxt
            mode
            ~source
            ~payer
            ~chain_id
            ~internal:true
            operation )
        >>= function
        | Error errors ->
            let result =
              Internal_operation_result
                (op, Failed (manager_kind op.operation, errors))
            in
            let skipped =
              List.rev_map
                (fun (Internal_operation op) ->
                  Internal_operation_result
                    (op, Skipped (manager_kind op.operation)))
                rest
            in
            Lwt.return (`Failure, List.rev (skipped @ (result :: applied)))
        | Ok (ctxt, result, emitted) ->
            apply
              ctxt
              (Internal_operation_result (op, Applied result) :: applied)
              (rest @ emitted) )
  in
  apply ctxt [] ops

let precheck_manager_contents (type kind) ctxt chain_id raw_operation
    (op : kind Kind.manager contents) : context tzresult Lwt.t =
  let (Manager_operation
        {source; fee; counter; operation; gas_limit; storage_limit}) =
    op
  in
  Lwt.return (Gas.check_limit ctxt gas_limit)
  >>=? fun () ->
  let ctxt = Gas.set_limit ctxt gas_limit in
  Lwt.return (Fees.check_storage_limit ctxt storage_limit)
  >>=? fun () ->
  Contract.must_be_allocated ctxt (Contract.implicit_contract source)
  >>=? fun () ->
  Contract.check_counter_increment ctxt source counter
  >>=? fun () ->
  ( match operation with
  | Reveal pk ->
      Contract.reveal_manager_key ctxt source pk
  | Transaction {parameters; _} ->
      (* Fail quickly if not enough gas for minimal deserialization cost *)
      Lwt.return
      @@ record_trace Gas_quota_exceeded_init_deserialize
      @@ Gas.check_enough ctxt (Script.minimal_deserialize_cost parameters)
      >>=? fun () ->
      (* Fail if not enough gas for complete deserialization cost *)
      trace Gas_quota_exceeded_init_deserialize
      @@ Script.force_decode ctxt parameters
      >>|? fun (_arg, ctxt) -> ctxt
  | Origination {script; _} ->
      (* Fail quickly if not enough gas for minimal deserialization cost *)
      Lwt.return
      @@ record_trace Gas_quota_exceeded_init_deserialize
      @@ ( Gas.consume ctxt (Script.minimal_deserialize_cost script.code)
         >>? fun ctxt ->
         Gas.check_enough ctxt (Script.minimal_deserialize_cost script.storage)
         )
      >>=? fun () ->
      (* Fail if not enough gas for complete deserialization cost *)
      trace Gas_quota_exceeded_init_deserialize
      @@ Script.force_decode ctxt script.code
      >>=? fun (_code, ctxt) ->
      trace Gas_quota_exceeded_init_deserialize
      @@ Script.force_decode ctxt script.storage
      >>|? fun (_storage, ctxt) -> ctxt
  | _ ->
      return ctxt )
  >>=? fun ctxt ->
  Contract.get_manager_key ctxt source
  >>=? fun public_key ->
  (* Currently, the `raw_operation` only contains one signature, so
     all operations are required to be from the same manager. This may
     change in the future, allowing several managers to group-sign a
     sequence of transactions.  *)
  Operation.check_signature public_key chain_id raw_operation
  >>=? fun () ->
  Contract.increment_counter ctxt source
  >>=? fun ctxt ->
  Contract.spend ctxt (Contract.implicit_contract source) fee
  >>=? fun ctxt -> add_fees ctxt fee >>=? fun ctxt -> return ctxt

let apply_manager_contents (type kind) ctxt mode chain_id
    (op : kind Kind.manager contents) :
    ( [`Success of context | `Failure]
    * kind manager_operation_result
    * packed_internal_operation_result list )
    Lwt.t =
  let (Manager_operation {source; operation; gas_limit; storage_limit}) = op in
  let ctxt = Gas.set_limit ctxt gas_limit in
  let ctxt = Fees.start_counting_storage_fees ctxt in
  let source = Contract.implicit_contract source in
  apply_manager_operation_content
    ctxt
    mode
    ~source
    ~payer:source
    ~internal:false
    ~chain_id
    operation
  >>= function
  | Ok (ctxt, operation_results, internal_operations) -> (
      apply_internal_manager_operations
        ctxt
        mode
        ~payer:source
        ~chain_id
        internal_operations
      >>= function
      | (`Success ctxt, internal_operations_results) -> (
          Fees.burn_storage_fees ctxt ~storage_limit ~payer:source
          >>= function
          | Ok ctxt ->
              Lwt.return
                ( `Success ctxt,
                  Applied operation_results,
                  internal_operations_results )
          | Error errors ->
              Lwt.return
                ( `Failure,
                  Backtracked (operation_results, Some errors),
                  internal_operations_results ) )
      | (`Failure, internal_operations_results) ->
          Lwt.return
            (`Failure, Applied operation_results, internal_operations_results)
      )
  | Error errors ->
      Lwt.return (`Failure, Failed (manager_kind operation, errors), [])

let skipped_operation_result :
    type kind. kind manager_operation -> kind manager_operation_result =
  function
  | operation -> (
    match operation with
    | Reveal _ ->
        Applied
          ( Reveal_result {consumed_gas = Z.zero}
            : kind successful_manager_operation_result )
    | _ ->
        Skipped (manager_kind operation) )

let rec mark_skipped :
    type kind.
    baker:Signature.Public_key_hash.t ->
    Level.t ->
    kind Kind.manager contents_list ->
    kind Kind.manager contents_result_list =
 fun ~baker level -> function
  | Single (Manager_operation {source; fee; operation}) ->
      let source = Contract.implicit_contract source in
      Single_result
        (Manager_operation_result
           {
             balance_updates =
               Delegate.cleanup_balance_updates
                 [ (Contract source, Debited fee);
                   (Fees (baker, level.cycle), Credited fee) ];
             operation_result = skipped_operation_result operation;
             internal_operation_results = [];
           })
  | Cons (Manager_operation {source; fee; operation}, rest) ->
      let source = Contract.implicit_contract source in
      Cons_result
        ( Manager_operation_result
            {
              balance_updates =
                Delegate.cleanup_balance_updates
                  [ (Contract source, Debited fee);
                    (Fees (baker, level.cycle), Credited fee) ];
              operation_result = skipped_operation_result operation;
              internal_operation_results = [];
            },
          mark_skipped ~baker level rest )

let rec precheck_manager_contents_list :
    type kind.
    Alpha_context.t ->
    Chain_id.t ->
    _ Operation.t ->
    kind Kind.manager contents_list ->
    context tzresult Lwt.t =
 fun ctxt chain_id raw_operation contents_list ->
  match contents_list with
  | Single (Manager_operation _ as op) ->
      precheck_manager_contents ctxt chain_id raw_operation op
  | Cons ((Manager_operation _ as op), rest) ->
      precheck_manager_contents ctxt chain_id raw_operation op
      >>=? fun ctxt ->
      precheck_manager_contents_list ctxt chain_id raw_operation rest

let rec apply_manager_contents_list_rec :
    type kind.
    Alpha_context.t ->
    Script_ir_translator.unparsing_mode ->
    public_key_hash ->
    Chain_id.t ->
    kind Kind.manager contents_list ->
    ([`Success of context | `Failure] * kind Kind.manager contents_result_list)
    Lwt.t =
 fun ctxt mode baker chain_id contents_list ->
  let level = Level.current ctxt in
  match contents_list with
  | Single (Manager_operation {source; fee; _} as op) ->
      let source = Contract.implicit_contract source in
      apply_manager_contents ctxt mode chain_id op
      >>= fun (ctxt_result, operation_result, internal_operation_results) ->
      let result =
        Manager_operation_result
          {
            balance_updates =
              Delegate.cleanup_balance_updates
                [ (Contract source, Debited fee);
                  (Fees (baker, level.cycle), Credited fee) ];
            operation_result;
            internal_operation_results;
          }
      in
      Lwt.return (ctxt_result, Single_result result)
  | Cons ((Manager_operation {source; fee; _} as op), rest) -> (
      let source = Contract.implicit_contract source in
      apply_manager_contents ctxt mode chain_id op
      >>= function
      | (`Failure, operation_result, internal_operation_results) ->
          let result =
            Manager_operation_result
              {
                balance_updates =
                  Delegate.cleanup_balance_updates
                    [ (Contract source, Debited fee);
                      (Fees (baker, level.cycle), Credited fee) ];
                operation_result;
                internal_operation_results;
              }
          in
          Lwt.return
            (`Failure, Cons_result (result, mark_skipped ~baker level rest))
      | (`Success ctxt, operation_result, internal_operation_results) ->
          let result =
            Manager_operation_result
              {
                balance_updates =
                  Delegate.cleanup_balance_updates
                    [ (Contract source, Debited fee);
                      (Fees (baker, level.cycle), Credited fee) ];
                operation_result;
                internal_operation_results;
              }
          in
          apply_manager_contents_list_rec ctxt mode baker chain_id rest
          >>= fun (ctxt_result, results) ->
          Lwt.return (ctxt_result, Cons_result (result, results)) )

let mark_backtracked results =
  let rec mark_contents_list :
      type kind.
      kind Kind.manager contents_result_list ->
      kind Kind.manager contents_result_list = function
    | Single_result (Manager_operation_result op) ->
        Single_result
          (Manager_operation_result
             {
               balance_updates = op.balance_updates;
               operation_result =
                 mark_manager_operation_result op.operation_result;
               internal_operation_results =
                 List.map
                   mark_internal_operation_results
                   op.internal_operation_results;
             })
    | Cons_result (Manager_operation_result op, rest) ->
        Cons_result
          ( Manager_operation_result
              {
                balance_updates = op.balance_updates;
                operation_result =
                  mark_manager_operation_result op.operation_result;
                internal_operation_results =
                  List.map
                    mark_internal_operation_results
                    op.internal_operation_results;
              },
            mark_contents_list rest )
  and mark_internal_operation_results
      (Internal_operation_result (kind, result)) =
    Internal_operation_result (kind, mark_manager_operation_result result)
  and mark_manager_operation_result :
      type kind. kind manager_operation_result -> kind manager_operation_result
      = function
    | (Failed _ | Skipped _ | Backtracked _) as result ->
        result
    | Applied (Reveal_result _) as result ->
        result
    | Applied result ->
        Backtracked (result, None)
  in
  mark_contents_list results

let apply_manager_contents_list ctxt mode baker chain_id contents_list =
  apply_manager_contents_list_rec ctxt mode baker chain_id contents_list
  >>= fun (ctxt_result, results) ->
  match ctxt_result with
  | `Failure ->
      Lwt.return (ctxt (* backtracked *), mark_backtracked results)
  | `Success ctxt ->
      Big_map.cleanup_temporary ctxt >>= fun ctxt -> Lwt.return (ctxt, results)

let apply_contents_list (type kind) ctxt chain_id mode pred_block baker
    (operation : kind operation) (contents_list : kind contents_list) :
    (context * kind contents_result_list) tzresult Lwt.t =
  match contents_list with
  | Single (Endorsement {level}) ->
      let block = operation.shell.branch in
      fail_unless
        (Block_hash.equal block pred_block)
        (Wrong_endorsement_predecessor (pred_block, block))
      >>=? fun () ->
      let current_level = (Level.current ctxt).level in
      fail_unless
        Raw_level.(succ level = current_level)
        Invalid_endorsement_level
      >>=? fun () ->
      Baking.check_endorsement_rights ctxt chain_id operation
      >>=? fun (delegate, slots, used) ->
      if used then fail (Duplicate_endorsement delegate)
      else
        let ctxt = record_endorsement ctxt delegate in
        let gap = List.length slots in
        Lwt.return
          Tez.(Constants.endorsement_security_deposit ctxt *? Int64.of_int gap)
        >>=? fun deposit ->
        Delegate.freeze_deposit ctxt delegate deposit
        >>=? fun ctxt ->
        Global.get_block_priority ctxt
        >>=? fun block_priority ->
        Baking.endorsing_reward ctxt ~block_priority gap
        >>=? fun reward ->
        Delegate.freeze_rewards ctxt delegate reward
        >>=? fun ctxt ->
        let level = Level.from_raw ctxt level in
        return
          ( ctxt,
            Single_result
              (Endorsement_result
                 {
                   balance_updates =
                     Delegate.cleanup_balance_updates
                       [ ( Contract (Contract.implicit_contract delegate),
                           Debited deposit );
                         (Deposits (delegate, level.cycle), Credited deposit);
                         (Rewards (delegate, level.cycle), Credited reward) ];
                   delegate;
                   slots;
                 }) )
  | Single (Seed_nonce_revelation {level; nonce}) ->
      let level = Level.from_raw ctxt level in
      Nonce.reveal ctxt level nonce
      >>=? fun ctxt ->
      let seed_nonce_revelation_tip =
        Constants.seed_nonce_revelation_tip ctxt
      in
      add_rewards ctxt seed_nonce_revelation_tip
      >>=? fun ctxt ->
      return
        ( ctxt,
          Single_result
            (Seed_nonce_revelation_result
               [ ( Rewards (baker, level.cycle),
                   Credited seed_nonce_revelation_tip ) ]) )
  | Single (Double_endorsement_evidence {op1; op2}) -> (
    match (op1.protocol_data.contents, op2.protocol_data.contents) with
    | (Single (Endorsement e1), Single (Endorsement e2))
      when Raw_level.(e1.level = e2.level)
           && not (Block_hash.equal op1.shell.branch op2.shell.branch) ->
        let level = Level.from_raw ctxt e1.level in
        let oldest_level = Level.last_allowed_fork_level ctxt in
        fail_unless
          Level.(level < Level.current ctxt)
          (Too_early_double_endorsement_evidence
             {level = level.level; current = (Level.current ctxt).level})
        >>=? fun () ->
        fail_unless
          Raw_level.(oldest_level <= level.level)
          (Outdated_double_endorsement_evidence
             {level = level.level; last = oldest_level})
        >>=? fun () ->
        Baking.check_endorsement_rights ctxt chain_id op1
        >>=? fun (delegate1, _, _) ->
        Baking.check_endorsement_rights ctxt chain_id op2
        >>=? fun (delegate2, _, _) ->
        fail_unless
          (Signature.Public_key_hash.equal delegate1 delegate2)
          (Inconsistent_double_endorsement_evidence {delegate1; delegate2})
        >>=? fun () ->
        Delegate.has_frozen_balance ctxt delegate1 level.cycle
        >>=? fun valid ->
        fail_unless valid Unrequired_double_endorsement_evidence
        >>=? fun () ->
        Delegate.punish ctxt delegate1 level.cycle
        >>=? fun (ctxt, balance) ->
        Lwt.return Tez.(balance.deposit +? balance.fees)
        >>=? fun burned ->
        let reward =
          match Tez.(burned /? 2L) with Ok v -> v | Error _ -> Tez.zero
        in
        add_rewards ctxt reward
        >>=? fun ctxt ->
        let current_cycle = (Level.current ctxt).cycle in
        return
          ( ctxt,
            Single_result
              (Double_endorsement_evidence_result
                 (Delegate.cleanup_balance_updates
                    [ ( Deposits (delegate1, level.cycle),
                        Debited balance.deposit );
                      (Fees (delegate1, level.cycle), Debited balance.fees);
                      ( Rewards (delegate1, level.cycle),
                        Debited balance.rewards );
                      (Rewards (baker, current_cycle), Credited reward) ])) )
    | (_, _) ->
        fail Invalid_double_endorsement_evidence )
  | Single (Double_baking_evidence {bh1; bh2}) ->
      let hash1 = Block_header.hash bh1 in
      let hash2 = Block_header.hash bh2 in
      fail_unless
        ( Compare.Int32.(bh1.shell.level = bh2.shell.level)
        && not (Block_hash.equal hash1 hash2) )
        (Invalid_double_baking_evidence
           {hash1; level1 = bh1.shell.level; hash2; level2 = bh2.shell.level})
      >>=? fun () ->
      Lwt.return (Raw_level.of_int32 bh1.shell.level)
      >>=? fun raw_level ->
      let oldest_level = Level.last_allowed_fork_level ctxt in
      fail_unless
        Raw_level.(raw_level < (Level.current ctxt).level)
        (Too_early_double_baking_evidence
           {level = raw_level; current = (Level.current ctxt).level})
      >>=? fun () ->
      fail_unless
        Raw_level.(oldest_level <= raw_level)
        (Outdated_double_baking_evidence
           {level = raw_level; last = oldest_level})
      >>=? fun () ->
      let level = Level.from_raw ctxt raw_level in
      Roll.baking_rights_owner
        ctxt
        level
        ~priority:bh1.protocol_data.contents.priority
      >>=? fun delegate1 ->
      Baking.check_signature bh1 chain_id delegate1
      >>=? fun () ->
      Roll.baking_rights_owner
        ctxt
        level
        ~priority:bh2.protocol_data.contents.priority
      >>=? fun delegate2 ->
      Baking.check_signature bh2 chain_id delegate2
      >>=? fun () ->
      fail_unless
        (Signature.Public_key.equal delegate1 delegate2)
        (Inconsistent_double_baking_evidence
           {
             delegate1 = Signature.Public_key.hash delegate1;
             delegate2 = Signature.Public_key.hash delegate2;
           })
      >>=? fun () ->
      let delegate = Signature.Public_key.hash delegate1 in
      Delegate.has_frozen_balance ctxt delegate level.cycle
      >>=? fun valid ->
      fail_unless valid Unrequired_double_baking_evidence
      >>=? fun () ->
      Delegate.punish ctxt delegate level.cycle
      >>=? fun (ctxt, balance) ->
      Lwt.return Tez.(balance.deposit +? balance.fees)
      >>=? fun burned ->
      let reward =
        match Tez.(burned /? 2L) with Ok v -> v | Error _ -> Tez.zero
      in
      add_rewards ctxt reward
      >>=? fun ctxt ->
      let current_cycle = (Level.current ctxt).cycle in
      return
        ( ctxt,
          Single_result
            (Double_baking_evidence_result
               (Delegate.cleanup_balance_updates
                  [ (Deposits (delegate, level.cycle), Debited balance.deposit);
                    (Fees (delegate, level.cycle), Debited balance.fees);
                    (Rewards (delegate, level.cycle), Debited balance.rewards);
                    (Rewards (baker, current_cycle), Credited reward) ])) )
  | Single (Activate_account {id = pkh; activation_code}) -> (
      let blinded_pkh =
        Blinded_public_key_hash.of_ed25519_pkh activation_code pkh
      in
      Commitment.get_opt ctxt blinded_pkh
      >>=? function
      | None ->
          fail (Invalid_activation {pkh})
      | Some amount ->
          Commitment.delete ctxt blinded_pkh
          >>=? fun ctxt ->
          let contract = Contract.implicit_contract (Signature.Ed25519 pkh) in
          Contract.(credit ctxt contract amount)
          >>=? fun ctxt ->
          return
            ( ctxt,
              Single_result
                (Activate_account_result [(Contract contract, Credited amount)])
            ) )
  | Single (Proposals {source; period; proposals}) ->
      Roll.delegate_pubkey ctxt source
      >>=? fun delegate ->
      Operation.check_signature delegate chain_id operation
      >>=? fun () ->
      let level = Level.current ctxt in
      fail_unless
        Voting_period.(level.voting_period = period)
        (Wrong_voting_period (level.voting_period, period))
      >>=? fun () ->
      Amendment.record_proposals ctxt source proposals
      >>=? fun ctxt -> return (ctxt, Single_result Proposals_result)
  | Single (Ballot {source; period; proposal; ballot}) ->
      Roll.delegate_pubkey ctxt source
      >>=? fun delegate ->
      Operation.check_signature delegate chain_id operation
      >>=? fun () ->
      let level = Level.current ctxt in
      fail_unless
        Voting_period.(level.voting_period = period)
        (Wrong_voting_period (level.voting_period, period))
      >>=? fun () ->
      Amendment.record_ballot ctxt source proposal ballot
      >>=? fun ctxt -> return (ctxt, Single_result Ballot_result)
  | Single (Manager_operation _) as op ->
      precheck_manager_contents_list ctxt chain_id operation op
      >>=? fun ctxt ->
      apply_manager_contents_list ctxt mode baker chain_id op
      >>= fun (ctxt, result) -> return (ctxt, result)
  | Cons (Manager_operation _, _) as op ->
      precheck_manager_contents_list ctxt chain_id operation op
      >>=? fun ctxt ->
      apply_manager_contents_list ctxt mode baker chain_id op
      >>= fun (ctxt, result) -> return (ctxt, result)

let apply_operation ctxt chain_id mode pred_block baker hash operation =
  let ctxt = Contract.init_origination_nonce ctxt hash in
  apply_contents_list
    ctxt
    chain_id
    mode
    pred_block
    baker
    operation
    operation.protocol_data.contents
  >>=? fun (ctxt, result) ->
  let ctxt = Gas.set_unlimited ctxt in
  let ctxt = Contract.unset_origination_nonce ctxt in
  return (ctxt, {contents = result})

let may_snapshot_roll ctxt =
  let level = Alpha_context.Level.current ctxt in
  let blocks_per_roll_snapshot = Constants.blocks_per_roll_snapshot ctxt in
  if
    Compare.Int32.equal
      (Int32.rem level.cycle_position blocks_per_roll_snapshot)
      (Int32.pred blocks_per_roll_snapshot)
  then Alpha_context.Roll.snapshot_rolls ctxt >>=? fun ctxt -> return ctxt
  else return ctxt

let may_start_new_cycle ctxt =
  Baking.dawn_of_a_new_cycle ctxt
  >>=? function
  | None ->
      return (ctxt, [], [])
  | Some last_cycle ->
      Seed.cycle_end ctxt last_cycle
      >>=? fun (ctxt, unrevealed) ->
      Roll.cycle_end ctxt last_cycle
      >>=? fun ctxt ->
      Delegate.cycle_end ctxt last_cycle unrevealed
      >>=? fun (ctxt, update_balances, deactivated) ->
      Bootstrap.cycle_end ctxt last_cycle
      >>=? fun ctxt -> return (ctxt, update_balances, deactivated)

let begin_full_construction ctxt pred_timestamp protocol_data =
  Alpha_context.Global.set_block_priority
    ctxt
    protocol_data.Block_header.priority
  >>=? fun ctxt ->
  Baking.check_baking_rights ctxt protocol_data pred_timestamp
  >>=? fun (delegate_pk, block_delay) ->
  let ctxt = Fitness.increase ctxt in
  match Level.pred ctxt (Level.current ctxt) with
  | None ->
      assert false (* genesis *)
  | Some pred_level ->
      Baking.endorsement_rights ctxt pred_level
      >>=? fun rights ->
      let ctxt = init_endorsements ctxt rights in
      return (ctxt, protocol_data, delegate_pk, block_delay)

let begin_partial_construction ctxt =
  let ctxt = Fitness.increase ctxt in
  match Level.pred ctxt (Level.current ctxt) with
  | None ->
      assert false (* genesis *)
  | Some pred_level ->
      Baking.endorsement_rights ctxt pred_level
      >>=? fun rights ->
      let ctxt = init_endorsements ctxt rights in
      return ctxt

let begin_application ctxt chain_id block_header pred_timestamp =
  Alpha_context.Global.set_block_priority
    ctxt
    block_header.Block_header.protocol_data.contents.priority
  >>=? fun ctxt ->
  let current_level = Alpha_context.Level.current ctxt in
  Baking.check_proof_of_work_stamp ctxt block_header
  >>=? fun () ->
  Baking.check_fitness_gap ctxt block_header
  >>=? fun () ->
  Baking.check_baking_rights
    ctxt
    block_header.protocol_data.contents
    pred_timestamp
  >>=? fun (delegate_pk, block_delay) ->
  Baking.check_signature block_header chain_id delegate_pk
  >>=? fun () ->
  let has_commitment =
    match block_header.protocol_data.contents.seed_nonce_hash with
    | None ->
        false
    | Some _ ->
        true
  in
  fail_unless
    Compare.Bool.(has_commitment = current_level.expected_commitment)
    (Invalid_commitment {expected = current_level.expected_commitment})
  >>=? fun () ->
  let ctxt = Fitness.increase ctxt in
  match Level.pred ctxt (Level.current ctxt) with
  | None ->
      assert false (* genesis *)
  | Some pred_level ->
      Baking.endorsement_rights ctxt pred_level
      >>=? fun rights ->
      let ctxt = init_endorsements ctxt rights in
      return (ctxt, delegate_pk, block_delay)

let check_minimum_endorsements ctxt protocol_data block_delay
    included_endorsements =
  let minimum = Baking.minimum_allowed_endorsements ctxt ~block_delay in
  let timestamp = Timestamp.current ctxt in
  fail_unless
    Compare.Int.(included_endorsements >= minimum)
    (Not_enough_endorsements_for_priority
       {
         required = minimum;
         priority = protocol_data.Block_header.priority;
         endorsements = included_endorsements;
         timestamp;
       })

let finalize_application ctxt protocol_data delegate ~block_delay =
  let included_endorsements = included_endorsements ctxt in
  check_minimum_endorsements
    ctxt
    protocol_data
    block_delay
    included_endorsements
  >>=? fun () ->
  let deposit = Constants.block_security_deposit ctxt in
  add_deposit ctxt delegate deposit
  >>=? fun ctxt ->
  Baking.baking_reward
    ctxt
    ~block_priority:protocol_data.priority
    ~included_endorsements
  >>=? fun reward ->
  add_rewards ctxt reward
  >>=? fun ctxt ->
  Signature.Public_key_hash.Map.fold
    (fun delegate deposit ctxt ->
      ctxt >>=? fun ctxt -> Delegate.freeze_deposit ctxt delegate deposit)
    (get_deposits ctxt)
    (return ctxt)
  >>=? fun ctxt ->
  (* end of level (from this point nothing should fail) *)
  let fees = Alpha_context.get_fees ctxt in
  Delegate.freeze_fees ctxt delegate fees
  >>=? fun ctxt ->
  let rewards = Alpha_context.get_rewards ctxt in
  Delegate.freeze_rewards ctxt delegate rewards
  >>=? fun ctxt ->
  ( match protocol_data.Block_header.seed_nonce_hash with
  | None ->
      return ctxt
  | Some nonce_hash ->
      Nonce.record_hash ctxt {nonce_hash; delegate; rewards; fees} )
  >>=? fun ctxt ->
  (* end of cycle *)
  may_snapshot_roll ctxt
  >>=? fun ctxt ->
  may_start_new_cycle ctxt
  >>=? fun (ctxt, balance_updates, deactivated) ->
  Amendment.may_start_new_voting_period ctxt
  >>=? fun ctxt ->
  let cycle = (Level.current ctxt).cycle in
  let balance_updates =
    Delegate.(
      cleanup_balance_updates
        ( [ (Contract (Contract.implicit_contract delegate), Debited deposit);
            (Deposits (delegate, cycle), Credited deposit);
            (Rewards (delegate, cycle), Credited reward) ]
        @ balance_updates ))
  in
  let consumed_gas =
    Z.sub
      (Constants.hard_gas_limit_per_block ctxt)
      (Alpha_context.Gas.block_level ctxt)
  in
  Alpha_context.Vote.get_current_period_kind ctxt
  >>=? fun voting_period_kind ->
  let receipt =
    Apply_results.
      {
        baker = delegate;
        level = Level.current ctxt;
        voting_period_kind;
        nonce_hash = protocol_data.seed_nonce_hash;
        consumed_gas;
        deactivated;
        balance_updates;
      }
  in
  return (ctxt, receipt)

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Import Alpha_context.

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Top-level evaluations are considered as an error as sources of side-effects *)
Compute
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "operation.wrong_endorsement_predecessor" % string
      "Wrong endorsement predecessor" % string
      "Trying to include an endorsement in a block that is not the successor of the endorsed one"
        % string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let '(e, p) := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Wrong predecessor " % string
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                      ", expected " % string
                      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                        Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format))))
                "Wrong predecessor %a, expected %a" % string) Block_hash.pp p
              Block_hash.pp e))
      (obj2 (req None None "expected" % string Block_hash.encoding)
        (req None None "provided" % string Block_hash.encoding))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Wrong_endorsement_predecessor
            e p => Some (e, p)
        | _ => None
        end)
      (fun function_parameter =>
        let '(e, p) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Wrong_endorsement_predecessor
          e p) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "operation.wrong_voting_period" % string
      "Wrong voting period" % string
      "Trying to onclude a proposal or ballot meant for another voting period" %
        string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let '(e, p) := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Wrong voting period " % string
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                      ", current is " % string
                      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                        Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format))))
                "Wrong voting period %a, current is %a" % string)
              Voting_period.pp p Voting_period.pp e))
      (obj2 (req None None "current" % string Voting_period.encoding)
        (req None None "provided" % string Voting_period.encoding))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Wrong_voting_period
            e p => Some (e, p)
        | _ => None
        end)
      (fun function_parameter =>
        let '(e, p) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Wrong_voting_period
          e p) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "operation.duplicate_endorsement" % string
      "Duplicate endorsement" % string
      "Two endorsements received from same delegate" % string
      (Some
        (fun ppf =>
          fun k =>
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Duplicate endorsement from delegate " % string
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                      " (possible replay attack)." % string
                      Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))
                "Duplicate endorsement from delegate %a (possible replay attack)."
                  % string) Signature.Public_key_hash.pp_short k))
      (obj1
        (req None None "delegate" % string Signature.Public_key_hash.encoding))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Duplicate_endorsement
            k => Some k
        | _ => None
        end)
      (fun k =>
        Tezos_protocol_environment_alpha__Environment.Error_monad.Duplicate_endorsement
          k) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "operation.invalid_endorsement_level" % string
      "Unexpected level in endorsement" % string
      "The level of an endorsement is inconsistent with the  provided block hash."
        % string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let 'tt := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Unexpected level in endorsement." % string
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
                "Unexpected level in endorsement." % string)))
      Data_encoding.__unit_value
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_endorsement_level
          => Some tt
        | _ => None
        end)
      (fun function_parameter =>
        let 'tt := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_endorsement_level)
    in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "block.invalid_commitment" % string
      "Invalid commitment in block header" % string
      "The block header has invalid commitment." % string
      (Some
        (fun ppf =>
          fun expected =>
            if expected then
              Format.fprintf ppf
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                    "Missing seed's nonce commitment in block header." % string
                    Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
                  "Missing seed's nonce commitment in block header." % string)
            else
              Format.fprintf ppf
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                    "Unexpected seed's nonce commitment in block header." %
                      string
                    Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
                  "Unexpected seed's nonce commitment in block header." % string)))
      (obj1 (req None None "expected" % string __bool_value))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_commitment
            {| Invalid_commitment.expected := expected |} => Some expected
        | _ => None
        end)
      (fun expected =>
        Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_commitment
          {| Invalid_commitment.expected := expected |}) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "internal_operation_replay" % string
      "Internal operation replay" % string
      "An internal operation was emitted twice by a script" % string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let
              'Tezos_raw_protocol_alpha.Alpha_context.Internal_operation {|
                Tezos_raw_protocol_alpha.Alpha_context.internal_operation.nonce := nonce
                  |} := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Internal operation " % string
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int
                    Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int_d
                    Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
                    Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_precision
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                      " was emitted twice by a script" % string
                      Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))
                "Internal operation %d was emitted twice by a script" % string)
              nonce)) Operation.internal_operation_encoding
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Internal_operation_replay
            op => Some op
        | _ => None
        end)
      (fun op =>
        Tezos_protocol_environment_alpha__Environment.Error_monad.Internal_operation_replay
          op) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "block.invalid_double_endorsement_evidence" % string
      "Invalid double endorsement evidence" % string
      "A double-endorsement evidence is malformed" % string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let 'tt := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Malformed double-endorsement evidence" % string
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
                "Malformed double-endorsement evidence" % string)))
      Data_encoding.empty
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_double_endorsement_evidence
          => Some tt
        | _ => None
        end)
      (fun function_parameter =>
        let 'tt := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_double_endorsement_evidence)
    in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "block.inconsistent_double_endorsement_evidence" % string
      "Inconsistent double endorsement evidence" % string
      "A double-endorsement evidence is inconsistent  (two distinct delegates)"
        % string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let '(delegate1, delegate2) := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Inconsistent double-endorsement evidence  (distinct delegate: "
                    % string
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                      " and " % string
                      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Char_literal
                          ")" % char
                          Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))))
                "Inconsistent double-endorsement evidence  (distinct delegate: %a and %a)"
                  % string) Signature.Public_key_hash.pp_short delegate1
              Signature.Public_key_hash.pp_short delegate2))
      (obj2
        (req None None "delegate1" % string Signature.Public_key_hash.encoding)
        (req None None "delegate2" % string Signature.Public_key_hash.encoding))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Inconsistent_double_endorsement_evidence
            {|
            Inconsistent_double_endorsement_evidence.delegate1 := delegate1;
              Inconsistent_double_endorsement_evidence.delegate2 := delegate2
              |} => Some (delegate1, delegate2)
        | _ => None
        end)
      (fun function_parameter =>
        let '(delegate1, delegate2) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Inconsistent_double_endorsement_evidence
          {| Inconsistent_double_endorsement_evidence.delegate1 := delegate1;
            Inconsistent_double_endorsement_evidence.delegate2 := delegate2 |})
    in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "block.unrequired_double_endorsement_evidence" % string
      "Unrequired double endorsement evidence" % string
      "A double-endorsement evidence is unrequired" % string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let 'tt := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "A valid double-endorsement operation cannot  be applied: the associated delegate  has previously been denunciated in this cycle."
                    % string
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
                "A valid double-endorsement operation cannot  be applied: the associated delegate  has previously been denunciated in this cycle."
                  % string))) Data_encoding.empty
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Unrequired_double_endorsement_evidence
          => Some tt
        | _ => None
        end)
      (fun function_parameter =>
        let 'tt := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Unrequired_double_endorsement_evidence)
    in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "block.too_early_double_endorsement_evidence" % string
      "Too early double endorsement evidence" % string
      "A double-endorsement evidence is in the future" % string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let '(level, current) := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "A double-endorsement evidence is in the future  (current level: "
                    % string
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                      ", endorsement level: " % string
                      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Char_literal
                          ")" % char
                          Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))))
                "A double-endorsement evidence is in the future  (current level: %a, endorsement level: %a)"
                  % string) Raw_level.pp current Raw_level.pp level))
      (obj2 (req None None "level" % string Raw_level.encoding)
        (req None None "current" % string Raw_level.encoding))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Too_early_double_endorsement_evidence
            {|
            Too_early_double_endorsement_evidence.level := level;
              Too_early_double_endorsement_evidence.current := current
              |} => Some (level, current)
        | _ => None
        end)
      (fun function_parameter =>
        let '(level, current) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Too_early_double_endorsement_evidence
          {| Too_early_double_endorsement_evidence.level := level;
            Too_early_double_endorsement_evidence.current := current |}) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "block.outdated_double_endorsement_evidence" % string
      "Outdated double endorsement evidence" % string
      "A double-endorsement evidence is outdated." % string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let '(level, last) := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "A double-endorsement evidence is outdated  (last acceptable level: "
                    % string
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                      ", endorsement level: " % string
                      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Char_literal
                          ")" % char
                          Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))))
                "A double-endorsement evidence is outdated  (last acceptable level: %a, endorsement level: %a)"
                  % string) Raw_level.pp last Raw_level.pp level))
      (obj2 (req None None "level" % string Raw_level.encoding)
        (req None None "last" % string Raw_level.encoding))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Outdated_double_endorsement_evidence
            {|
            Outdated_double_endorsement_evidence.level := level;
              Outdated_double_endorsement_evidence.last := last
              |} => Some (level, last)
        | _ => None
        end)
      (fun function_parameter =>
        let '(level, last) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Outdated_double_endorsement_evidence
          {| Outdated_double_endorsement_evidence.level := level;
            Outdated_double_endorsement_evidence.last := last |}) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "block.invalid_double_baking_evidence" % string
      "Invalid double baking evidence" % string
      "A double-baking evidence is inconsistent  (two distinct level)" % string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let '(hash1, level1, hash2, level2) := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Invalid double-baking evidence (hash: " % string
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                      " and " % string
                      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                          ", levels: " % string
                          (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int32
                            Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int_d
                            Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
                            Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_precision
                            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                              " and " % string
                              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int32
                                Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int_d
                                Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
                                Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_precision
                                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Char_literal
                                  ")" % char
                                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))))))))
                "Invalid double-baking evidence (hash: %a and %a, levels: %ld and %ld)"
                  % string) Block_hash.pp hash1 Block_hash.pp hash2 level1
              level2))
      (obj4 (req None None "hash1" % string Block_hash.encoding)
        (req None None "level1" % string __int32_value)
        (req None None "hash2" % string Block_hash.encoding)
        (req None None "level2" % string __int32_value))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_double_baking_evidence
            {|
            Invalid_double_baking_evidence.hash1 := hash1;
              Invalid_double_baking_evidence.level1 := level1;
              Invalid_double_baking_evidence.hash2 := hash2;
              Invalid_double_baking_evidence.level2 := level2
              |} => Some (hash1, level1, hash2, level2)
        | _ => None
        end)
      (fun function_parameter =>
        let '(hash1, level1, hash2, level2) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_double_baking_evidence
          {| Invalid_double_baking_evidence.hash1 := hash1;
            Invalid_double_baking_evidence.level1 := level1;
            Invalid_double_baking_evidence.hash2 := hash2;
            Invalid_double_baking_evidence.level2 := level2 |}) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "block.inconsistent_double_baking_evidence" % string
      "Inconsistent double baking evidence" % string
      "A double-baking evidence is inconsistent  (two distinct delegates)" %
        string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let '(delegate1, delegate2) := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Inconsistent double-baking evidence  (distinct delegate: " %
                    string
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                      " and " % string
                      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Char_literal
                          ")" % char
                          Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))))
                "Inconsistent double-baking evidence  (distinct delegate: %a and %a)"
                  % string) Signature.Public_key_hash.pp_short delegate1
              Signature.Public_key_hash.pp_short delegate2))
      (obj2
        (req None None "delegate1" % string Signature.Public_key_hash.encoding)
        (req None None "delegate2" % string Signature.Public_key_hash.encoding))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Inconsistent_double_baking_evidence
            {|
            Inconsistent_double_baking_evidence.delegate1 := delegate1;
              Inconsistent_double_baking_evidence.delegate2 := delegate2
              |} => Some (delegate1, delegate2)
        | _ => None
        end)
      (fun function_parameter =>
        let '(delegate1, delegate2) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Inconsistent_double_baking_evidence
          {| Inconsistent_double_baking_evidence.delegate1 := delegate1;
            Inconsistent_double_baking_evidence.delegate2 := delegate2 |}) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "block.unrequired_double_baking_evidence" % string
      "Unrequired double baking evidence" % string
      "A double-baking evidence is unrequired" % string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let 'tt := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "A valid double-baking operation cannot  be applied: the associated delegate  has previously been denunciated in this cycle."
                    % string
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
                "A valid double-baking operation cannot  be applied: the associated delegate  has previously been denunciated in this cycle."
                  % string))) Data_encoding.empty
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Unrequired_double_baking_evidence
          => Some tt
        | _ => None
        end)
      (fun function_parameter =>
        let 'tt := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Unrequired_double_baking_evidence)
    in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "block.too_early_double_baking_evidence" % string
      "Too early double baking evidence" % string
      "A double-baking evidence is in the future" % string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let '(level, current) := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "A double-baking evidence is in the future  (current level: "
                    % string
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                      ", baking level: " % string
                      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Char_literal
                          ")" % char
                          Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))))
                "A double-baking evidence is in the future  (current level: %a, baking level: %a)"
                  % string) Raw_level.pp current Raw_level.pp level))
      (obj2 (req None None "level" % string Raw_level.encoding)
        (req None None "current" % string Raw_level.encoding))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Too_early_double_baking_evidence
            {|
            Too_early_double_baking_evidence.level := level;
              Too_early_double_baking_evidence.current := current
              |} => Some (level, current)
        | _ => None
        end)
      (fun function_parameter =>
        let '(level, current) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Too_early_double_baking_evidence
          {| Too_early_double_baking_evidence.level := level;
            Too_early_double_baking_evidence.current := current |}) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "block.outdated_double_baking_evidence" % string
      "Outdated double baking evidence" % string
      "A double-baking evidence is outdated." % string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let '(level, last) := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "A double-baking evidence is outdated  (last acceptable level: "
                    % string
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                      ", baking level: " % string
                      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Char_literal
                          ")" % char
                          Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))))
                "A double-baking evidence is outdated  (last acceptable level: %a, baking level: %a)"
                  % string) Raw_level.pp last Raw_level.pp level))
      (obj2 (req None None "level" % string Raw_level.encoding)
        (req None None "last" % string Raw_level.encoding))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Outdated_double_baking_evidence
            {|
            Outdated_double_baking_evidence.level := level;
              Outdated_double_baking_evidence.last := last
              |} => Some (level, last)
        | _ => None
        end)
      (fun function_parameter =>
        let '(level, last) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Outdated_double_baking_evidence
          {| Outdated_double_baking_evidence.level := level;
            Outdated_double_baking_evidence.last := last |}) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "operation.invalid_activation" % string
      "Invalid activation" % string
      "The given key and secret do not correspond to any existing preallocated contract"
        % string
      (Some
        (fun ppf =>
          fun pkh =>
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Invalid activation. The public key " % string
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                      " does not match any commitment." % string
                      Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))
                "Invalid activation. The public key %a does not match any commitment."
                  % string) Ed25519.Public_key_hash.pp pkh))
      (obj1 (req None None "pkh" % string Ed25519.Public_key_hash.encoding))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_activation
            {| Invalid_activation.pkh := pkh |} => Some pkh
        | _ => None
        end)
      (fun pkh =>
        Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_activation
          {| Invalid_activation.pkh := pkh |}) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "block.multiple_revelation" % string
      "Multiple revelations were included in a manager operation" % string
      "A manager operation should not contain more than one revelation" % string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let 'tt := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Multiple revelations were included in a manager operation" %
                    string
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
                "Multiple revelations were included in a manager operation" %
                  string))) Data_encoding.empty
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Multiple_revelation
          => Some tt
        | _ => None
        end)
      (fun function_parameter =>
        let 'tt := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Multiple_revelation)
    in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "gas_exhausted.init_deserialize" % string
      "Not enough gas for initial deserialization of script expresions" % string
      "Gas limit was not high enough to deserialize the transaction parameters or origination script code or initial storage, making the operation impossible to parse within the provided gas bounds."
        % string None Data_encoding.empty
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Gas_quota_exceeded_init_deserialize
          => Some tt
        | _ => None
        end)
      (fun function_parameter =>
        let 'tt := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Gas_quota_exceeded_init_deserialize)
    in
  register_error_kind
    (* ❌ Variants not supported *)
    variant "operation.not_enought_endorsements_for_priority" % string
    "Not enough endorsements for priority" % string
    "The block being validated does not include the required minimum number of endorsements for this priority."
      % string
    (Some
      (fun ppf =>
        fun function_parameter =>
          let '(required, endorsements, priority, timestamp) :=
            function_parameter in
          Format.fprintf ppf
            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                "Wrong number of endorsements (" % string
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int_i
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_precision
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                    ") for priority (" % string
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int
                      Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int_i
                      Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
                      Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_precision
                      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                        "), " % string
                        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int
                          Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int_i
                          Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
                          Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_precision
                          (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                            " are expected at " % string
                            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                              Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format))))))))
              "Wrong number of endorsements (%i) for priority (%i), %i are expected at %a"
                % string) endorsements priority required Time.pp_hum timestamp))
    (obj4 (req None None "required" % string int31)
      (req None None "endorsements" % string int31)
      (req None None "priority" % string int31)
      (req None None "timestamp" % string Time.encoding))
    (fun function_parameter =>
      match function_parameter with
      |
        Tezos_protocol_environment_alpha__Environment.Error_monad.Not_enough_endorsements_for_priority
          {|
          Not_enough_endorsements_for_priority.required := required;
            Not_enough_endorsements_for_priority.priority := priority;
            Not_enough_endorsements_for_priority.endorsements := endorsements;
            Not_enough_endorsements_for_priority.timestamp := timestamp
            |} => Some (required, endorsements, priority, timestamp)
      | _ => None
      end)
    (fun function_parameter =>
      let '(required, endorsements, priority, timestamp) := function_parameter
        in
      Tezos_protocol_environment_alpha__Environment.Error_monad.Not_enough_endorsements_for_priority
        {| Not_enough_endorsements_for_priority.required := required;
          Not_enough_endorsements_for_priority.priority := priority;
          Not_enough_endorsements_for_priority.endorsements := endorsements;
          Not_enough_endorsements_for_priority.timestamp := timestamp |}).

Import Apply_results.

Definition apply_manager_operation_content {kind : Set}
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.t)
  (mode : Tezos_raw_protocol_alpha.Script_ir_translator.unparsing_mode)
  (payer : Tezos_raw_protocol_alpha.Alpha_context.Contract.t)
  (source : Tezos_raw_protocol_alpha.Alpha_context.Contract.t)
  (chain_id : Tezos_protocol_environment_alpha__Environment.Chain_id.t)
  (internal : bool)
  (operation : Tezos_raw_protocol_alpha.Alpha_context.manager_operation kind)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Alpha_context.context *
        Tezos_raw_protocol_alpha.Apply_results.successful_manager_operation_result
          kind *
        list Tezos_raw_protocol_alpha.Alpha_context.packed_internal_operation)) :=
  let before_operation := ctxt in
  op_gtgteqquestion (Contract.must_exist ctxt source)
    (fun function_parameter =>
      let 'tt := function_parameter in
      op_gtgteqquestion
        (Lwt.__return
          (Gas.consume ctxt Michelson_v1_gas.Cost_of.manager_operation))
        (fun ctxt =>
          match operation with
          | Tezos_raw_protocol_alpha.Alpha_context.Reveal _ =>
            __return
              (ctxt,
                (Tezos_raw_protocol_alpha.Apply_results.Reveal_result
                  {|
                    Tezos_raw_protocol_alpha.Apply_results.successful_manager_operation_result.Reveal_result.consumed_gas :=
                      Gas.consumed before_operation ctxt |}), [])
          |
            Tezos_raw_protocol_alpha.Alpha_context.Transaction {|
              Tezos_raw_protocol_alpha.Alpha_context.manager_operation.Transaction.amount :=
                amount;
                Tezos_raw_protocol_alpha.Alpha_context.manager_operation.Transaction.parameters
                  := parameters;
                Tezos_raw_protocol_alpha.Alpha_context.manager_operation.Transaction.entrypoint
                  := entrypoint;
                Tezos_raw_protocol_alpha.Alpha_context.manager_operation.Transaction.destination
                  := destination
                |} =>
            op_gtgteqquestion (Contract.spend ctxt source amount)
              (fun ctxt =>
                op_gtgteqquestion
                  match Contract.is_implicit destination with
                  | None => __return (ctxt, [], false)
                  | Some _ =>
                    op_gtgteqquestion (Contract.allocated ctxt destination)
                      (fun function_parameter =>
                        match function_parameter with
                        | true => __return (ctxt, [], false)
                        | false =>
                          op_gtgteqquestion (Fees.origination_burn ctxt)
                            (fun function_parameter =>
                              let '(ctxt, origination_burn) :=
                                function_parameter in
                              __return
                                (ctxt,
                                  (cons
                                    ((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Contract
                                      payer),
                                      (Tezos_raw_protocol_alpha.Alpha_context.Delegate.Debited
                                        origination_burn)) []), true))
                        end)
                  end
                  (fun function_parameter =>
                    let
                      '(ctxt, maybe_burn_balance_update,
                        allocated_destination_contract) := function_parameter in
                    op_gtgteqquestion (Contract.credit ctxt destination amount)
                      (fun ctxt =>
                        op_gtgteqquestion (Contract.get_script ctxt destination)
                          (fun function_parameter =>
                            let '(ctxt, script) := function_parameter in
                            match script with
                            | None =>
                              op_gtgteqquestion
                                (op_gtgteqquestion
                                  match entrypoint with
                                  | "default" % string => __return tt
                                  | entrypoint =>
                                    fail
                                      (Tezos_protocol_environment_alpha__Environment.Error_monad.No_such_entrypoint
                                        entrypoint)
                                  end
                                  (fun function_parameter =>
                                    let 'tt := function_parameter in
                                    op_gtgteqquestion
                                      (Script.force_decode ctxt parameters)
                                      (fun function_parameter =>
                                        let '(arg, ctxt) := function_parameter
                                          in
                                        let cost_arg :=
                                          Script.deserialized_cost arg in
                                        op_gtgteqquestion
                                          (Lwt.__return
                                            (Gas.consume ctxt cost_arg))
                                          (fun ctxt =>
                                            match Micheline.root arg with
                                            |
                                              Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                _
                                                Tezos_raw_protocol_alpha.Alpha_context.Script.D_Unit
                                                [] _ => __return ctxt
                                            | _ =>
                                              fail
                                                (Tezos_protocol_environment_alpha__Environment.Error_monad.Bad_contract_parameter
                                                  destination)
                                            end))))
                                (fun ctxt =>
                                  let __result_value :=
                                    Tezos_raw_protocol_alpha.Apply_results.Transaction_result
                                      {|
                                        Tezos_raw_protocol_alpha.Apply_results.successful_manager_operation_result.Transaction_result.storage :=
                                          None;
                                        Tezos_raw_protocol_alpha.Apply_results.successful_manager_operation_result.Transaction_result.big_map_diff :=
                                          None;
                                        Tezos_raw_protocol_alpha.Apply_results.successful_manager_operation_result.Transaction_result.balance_updates :=
                                          Delegate.cleanup_balance_updates
                                            (op_at
                                              (cons
                                                ((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Contract
                                                  source),
                                                  (Tezos_raw_protocol_alpha.Alpha_context.Delegate.Debited
                                                    amount))
                                                (cons
                                                  ((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Contract
                                                    destination),
                                                    (Tezos_raw_protocol_alpha.Alpha_context.Delegate.Credited
                                                      amount)) []))
                                              maybe_burn_balance_update);
                                        Tezos_raw_protocol_alpha.Apply_results.successful_manager_operation_result.Transaction_result.originated_contracts :=
                                          [];
                                        Tezos_raw_protocol_alpha.Apply_results.successful_manager_operation_result.Transaction_result.consumed_gas :=
                                          Gas.consumed before_operation ctxt;
                                        Tezos_raw_protocol_alpha.Apply_results.successful_manager_operation_result.Transaction_result.storage_size :=
                                          Z.zero;
                                        Tezos_raw_protocol_alpha.Apply_results.successful_manager_operation_result.Transaction_result.paid_storage_size_diff :=
                                          Z.zero;
                                        Tezos_raw_protocol_alpha.Apply_results.successful_manager_operation_result.Transaction_result.allocated_destination_contract :=
                                          allocated_destination_contract |} in
                                  __return (ctxt, __result_value, []))
                            | Some script =>
                              op_gtgteqquestion
                                (Script.force_decode ctxt parameters)
                                (fun function_parameter =>
                                  let '(parameter, ctxt) := function_parameter
                                    in
                                  let cost_parameter :=
                                    Script.deserialized_cost parameter in
                                  op_gtgteqquestion
                                    (Lwt.__return
                                      (Gas.consume ctxt cost_parameter))
                                    (fun ctxt =>
                                      let step_constants :=
                                        {|
                                          Tezos_raw_protocol_alpha.Script_interpreter.step_constants.source :=
                                            source;
                                          Tezos_raw_protocol_alpha.Script_interpreter.step_constants.payer :=
                                            payer;
                                          Tezos_raw_protocol_alpha.Script_interpreter.step_constants.self :=
                                            destination;
                                          Tezos_raw_protocol_alpha.Script_interpreter.step_constants.amount :=
                                            amount;
                                          Tezos_raw_protocol_alpha.Script_interpreter.step_constants.chain_id :=
                                            chain_id |} in
                                      op_gtgteqquestion
                                        (Script_interpreter.execute ctxt mode
                                          step_constants script entrypoint
                                          parameter)
                                        (fun function_parameter =>
                                          let '{|
                                            Tezos_raw_protocol_alpha.Script_interpreter.execution_result.ctxt := ctxt;
                                              Tezos_raw_protocol_alpha.Script_interpreter.execution_result.storage
                                                :=
                                                storage;
                                              Tezos_raw_protocol_alpha.Script_interpreter.execution_result.big_map_diff
                                                :=
                                                big_map_diff;
                                              Tezos_raw_protocol_alpha.Script_interpreter.execution_result.operations
                                                :=
                                                operations
                                              |} := function_parameter in
                                          op_gtgteqquestion
                                            (Contract.update_script_storage ctxt
                                              destination storage big_map_diff)
                                            (fun ctxt =>
                                              op_gtgteqquestion
                                                (Fees.record_paid_storage_space
                                                  ctxt destination)
                                                (fun function_parameter =>
                                                  let
                                                    '(ctxt, new_size,
                                                      paid_storage_size_diff,
                                                      fees) :=
                                                    function_parameter in
                                                  op_gtgteqquestion
                                                    (Contract.originated_from_current_nonce
                                                      before_operation ctxt)
                                                    (fun originated_contracts =>
                                                      let __result_value :=
                                                        Tezos_raw_protocol_alpha.Apply_results.Transaction_result
                                                          {|
                                                            Tezos_raw_protocol_alpha.Apply_results.successful_manager_operation_result.Transaction_result.storage :=
                                                              Some storage;
                                                            Tezos_raw_protocol_alpha.Apply_results.successful_manager_operation_result.Transaction_result.big_map_diff :=
                                                              big_map_diff;
                                                            Tezos_raw_protocol_alpha.Apply_results.successful_manager_operation_result.Transaction_result.balance_updates :=
                                                              Delegate.cleanup_balance_updates
                                                                (cons
                                                                  ((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Contract
                                                                    payer),
                                                                    (Tezos_raw_protocol_alpha.Alpha_context.Delegate.Debited
                                                                      fees))
                                                                  (cons
                                                                    ((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Contract
                                                                      source),
                                                                      (Tezos_raw_protocol_alpha.Alpha_context.Delegate.Debited
                                                                        amount))
                                                                    (cons
                                                                      ((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Contract
                                                                        destination),
                                                                        (Tezos_raw_protocol_alpha.Alpha_context.Delegate.Credited
                                                                          amount))
                                                                      [])));
                                                            Tezos_raw_protocol_alpha.Apply_results.successful_manager_operation_result.Transaction_result.originated_contracts :=
                                                              originated_contracts;
                                                            Tezos_raw_protocol_alpha.Apply_results.successful_manager_operation_result.Transaction_result.consumed_gas :=
                                                              Gas.consumed
                                                                before_operation
                                                                ctxt;
                                                            Tezos_raw_protocol_alpha.Apply_results.successful_manager_operation_result.Transaction_result.storage_size :=
                                                              new_size;
                                                            Tezos_raw_protocol_alpha.Apply_results.successful_manager_operation_result.Transaction_result.paid_storage_size_diff :=
                                                              paid_storage_size_diff;
                                                            Tezos_raw_protocol_alpha.Apply_results.successful_manager_operation_result.Transaction_result.allocated_destination_contract :=
                                                              allocated_destination_contract
                                                            |} in
                                                      __return
                                                        (ctxt, __result_value,
                                                          operations)))))))
                            end))))
          |
            Tezos_raw_protocol_alpha.Alpha_context.Origination {|
              Tezos_raw_protocol_alpha.Alpha_context.manager_operation.Origination.delegate
                := delegate;
                Tezos_raw_protocol_alpha.Alpha_context.manager_operation.Origination.script
                  := script;
                Tezos_raw_protocol_alpha.Alpha_context.manager_operation.Origination.credit
                  := credit;
                Tezos_raw_protocol_alpha.Alpha_context.manager_operation.Origination.preorigination
                  := preorigination
                |} =>
            op_gtgteqquestion
              (Script.force_decode ctxt
                (Tezos_raw_protocol_alpha.Alpha_context.Script.t.storage script))
              (fun function_parameter =>
                let '(unparsed_storage, ctxt) := function_parameter in
                op_gtgteqquestion
                  (Lwt.__return
                    (Gas.consume ctxt
                      (Script.deserialized_cost unparsed_storage)))
                  (fun ctxt =>
                    op_gtgteqquestion
                      (Script.force_decode ctxt
                        (Tezos_raw_protocol_alpha.Alpha_context.Script.t.code
                          script))
                      (fun function_parameter =>
                        let '(unparsed_code, ctxt) := function_parameter in
                        op_gtgteqquestion
                          (Lwt.__return
                            (Gas.consume ctxt
                              (Script.deserialized_cost unparsed_code)))
                          (fun ctxt =>
                            op_gtgteqquestion
                              (Script_ir_translator.parse_script None ctxt false
                                script)
                              (fun function_parameter =>
                                let
                                  '(Tezos_raw_protocol_alpha.Script_ir_translator.Ex_script
                                    parsed_script, ctxt) := function_parameter
                                  in
                                op_gtgteqquestion
                                  (Script_ir_translator.collect_big_maps ctxt
                                    (Tezos_raw_protocol_alpha.Script_typed_ir.script.storage_type
                                      parsed_script)
                                    (Tezos_raw_protocol_alpha.Script_typed_ir.script.storage
                                      parsed_script))
                                  (fun function_parameter =>
                                    let '(to_duplicate, ctxt) :=
                                      function_parameter in
                                    let to_update :=
                                      Script_ir_translator.no_big_map_id in
                                    op_gtgteqquestion
                                      (Script_ir_translator.extract_big_map_diff
                                        ctxt
                                        Tezos_raw_protocol_alpha.Script_ir_translator.Optimized
                                        false to_duplicate to_update
                                        (Tezos_raw_protocol_alpha.Script_typed_ir.script.storage_type
                                          parsed_script)
                                        (Tezos_raw_protocol_alpha.Script_typed_ir.script.storage
                                          parsed_script))
                                      (fun function_parameter =>
                                        let '(storage, big_map_diff, ctxt) :=
                                          function_parameter in
                                        op_gtgteqquestion
                                          (Script_ir_translator.unparse_data
                                            ctxt
                                            Tezos_raw_protocol_alpha.Script_ir_translator.Optimized
                                            (Tezos_raw_protocol_alpha.Script_typed_ir.script.storage_type
                                              parsed_script) storage)
                                          (fun function_parameter =>
                                            let '(storage, ctxt) :=
                                              function_parameter in
                                            let storage :=
                                              Script.lazy_expr
                                                (Micheline.strip_locations
                                                  storage) in
                                            let script :=
                                              (* ❌ Record substitution not handled *)
                                              record_substitution in
                                            op_gtgteqquestion
                                              (Contract.spend ctxt source credit)
                                              (fun ctxt =>
                                                op_gtgteqquestion
                                                  match preorigination with
                                                  | Some contract =>
                                                    (* ❌ Sequences of instructions are not handled (operator ";") *)
                                                    let _ :=
                                                      (* ❌ Assert instruction is not handled. *)
                                                      assert internal in
                                                    __return (ctxt, contract)
                                                  | None =>
                                                    Contract.fresh_contract_from_current_nonce
                                                      ctxt
                                                  end
                                                  (fun function_parameter =>
                                                    let '(ctxt, contract) :=
                                                      function_parameter in
                                                    op_gtgteqquestion
                                                      (Contract.originate ctxt
                                                        contract credit
                                                        (script, big_map_diff)
                                                        delegate)
                                                      (fun ctxt =>
                                                        op_gtgteqquestion
                                                          (Fees.origination_burn
                                                            ctxt)
                                                          (fun
                                                            function_parameter
                                                            =>
                                                            let
                                                              '(ctxt,
                                                                origination_burn) :=
                                                              function_parameter
                                                              in
                                                            op_gtgteqquestion
                                                              (Fees.record_paid_storage_space
                                                                ctxt contract)
                                                              (fun
                                                                function_parameter
                                                                =>
                                                                let
                                                                  '(ctxt, size,
                                                                    paid_storage_size_diff,
                                                                    fees) :=
                                                                  function_parameter
                                                                  in
                                                                let
                                                                  __result_value :=
                                                                  Tezos_raw_protocol_alpha.Apply_results.Origination_result
                                                                    {|
                                                                      Tezos_raw_protocol_alpha.Apply_results.successful_manager_operation_result.Origination_result.big_map_diff :=
                                                                        big_map_diff;
                                                                      Tezos_raw_protocol_alpha.Apply_results.successful_manager_operation_result.Origination_result.balance_updates :=
                                                                        Delegate.cleanup_balance_updates
                                                                          (cons
                                                                            ((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Contract
                                                                              payer),
                                                                              (Tezos_raw_protocol_alpha.Alpha_context.Delegate.Debited
                                                                                fees))
                                                                            (cons
                                                                              ((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Contract
                                                                                payer),
                                                                                (Tezos_raw_protocol_alpha.Alpha_context.Delegate.Debited
                                                                                  origination_burn))
                                                                              (cons
                                                                                ((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Contract
                                                                                  source),
                                                                                  (Tezos_raw_protocol_alpha.Alpha_context.Delegate.Debited
                                                                                    credit))
                                                                                (cons
                                                                                  ((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Contract
                                                                                    contract),
                                                                                    (Tezos_raw_protocol_alpha.Alpha_context.Delegate.Credited
                                                                                      credit))
                                                                                  []))));
                                                                      Tezos_raw_protocol_alpha.Apply_results.successful_manager_operation_result.Origination_result.originated_contracts :=
                                                                        cons
                                                                          contract
                                                                          [];
                                                                      Tezos_raw_protocol_alpha.Apply_results.successful_manager_operation_result.Origination_result.consumed_gas :=
                                                                        Gas.consumed
                                                                          before_operation
                                                                          ctxt;
                                                                      Tezos_raw_protocol_alpha.Apply_results.successful_manager_operation_result.Origination_result.storage_size :=
                                                                        size;
                                                                      Tezos_raw_protocol_alpha.Apply_results.successful_manager_operation_result.Origination_result.paid_storage_size_diff :=
                                                                        paid_storage_size_diff
                                                                      |} in
                                                                __return
                                                                  (ctxt,
                                                                    __result_value,
                                                                    []))))))))))))))
          | Tezos_raw_protocol_alpha.Alpha_context.Delegation delegate =>
            op_gtgteqquestion (Delegate.set ctxt source delegate)
              (fun ctxt =>
                __return
                  (ctxt,
                    (Tezos_raw_protocol_alpha.Apply_results.Delegation_result
                      {|
                        Tezos_raw_protocol_alpha.Apply_results.successful_manager_operation_result.Delegation_result.consumed_gas :=
                          Gas.consumed before_operation ctxt |}), []))
          end)).

Definition apply_internal_manager_operations
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
  (mode : Tezos_raw_protocol_alpha.Script_ir_translator.unparsing_mode)
  (payer : Tezos_raw_protocol_alpha.Alpha_context.Contract.t)
  (chain_id : Tezos_protocol_environment_alpha__Environment.Chain_id.t)
  (ops : list Tezos_raw_protocol_alpha.Alpha_context.packed_internal_operation)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (((* `Success *) Tezos_raw_protocol_alpha.Alpha_context.context +
      (* `Failure *) unit) *
      list
        Tezos_raw_protocol_alpha.Apply_results.packed_internal_operation_result) :=
  let fix apply
    (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context) (applied :
    list Tezos_raw_protocol_alpha.Apply_results.packed_internal_operation_result)
    (worklist :
    list Tezos_raw_protocol_alpha.Alpha_context.packed_internal_operation)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      ((* `Success *) Tezos_raw_protocol_alpha.Alpha_context.context *
        list
          Tezos_raw_protocol_alpha.Apply_results.packed_internal_operation_result) :=
    match worklist with
    | [] =>
      Lwt.__return
        ((* ❌ Variants not supported *)
        variant, (List.rev applied))
    |
      cons
        (Tezos_raw_protocol_alpha.Alpha_context.Internal_operation
          ({|
            Tezos_raw_protocol_alpha.Alpha_context.internal_operation.source := source;
              Tezos_raw_protocol_alpha.Alpha_context.internal_operation.operation
                := operation;
              Tezos_raw_protocol_alpha.Alpha_context.internal_operation.nonce :=
                nonce
              |} as op)) rest =>
      op_gtgteq
        (if internal_nonce_already_recorded ctxt nonce then
          fail
            (Tezos_protocol_environment_alpha__Environment.Error_monad.Internal_operation_replay
              (Tezos_raw_protocol_alpha.Alpha_context.Internal_operation op))
        else
          let ctxt := record_internal_nonce ctxt nonce in
          apply_manager_operation_content ctxt mode payer source chain_id true
            operation)
        (fun function_parameter =>
          match function_parameter with
          |
            Tezos_protocol_environment_alpha__Environment.Pervasives.Error
              errors =>
            let __result_value :=
              Tezos_raw_protocol_alpha.Apply_results.Internal_operation_result
                op
                (Tezos_raw_protocol_alpha.Apply_results.Failed
                  (manager_kind
                    (Tezos_raw_protocol_alpha.Alpha_context.internal_operation.operation
                      op)) errors) in
            let skipped :=
              List.rev_map
                (fun function_parameter =>
                  let
                    'Tezos_raw_protocol_alpha.Alpha_context.Internal_operation
                      op := function_parameter in
                  Tezos_raw_protocol_alpha.Apply_results.Internal_operation_result
                    op
                    (Tezos_raw_protocol_alpha.Apply_results.Skipped
                      (manager_kind
                        (Tezos_raw_protocol_alpha.Alpha_context.internal_operation.operation
                          op)))) rest in
            Lwt.__return
              ((* ❌ Variants not supported *)
              variant, (List.rev (op_at skipped (cons __result_value applied))))
          |
            Tezos_protocol_environment_alpha__Environment.Pervasives.Ok
              (ctxt, __result_value, emitted) =>
            apply ctxt
              (cons
                (Tezos_raw_protocol_alpha.Apply_results.Internal_operation_result
                  op
                  (Tezos_raw_protocol_alpha.Apply_results.Applied __result_value))
                applied) (op_at rest emitted)
          end)
    end in
  apply ctxt [] ops.

Definition precheck_manager_contents {A B : Set}
  (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
  (chain_id : Tezos_protocol_environment_alpha__Environment.Chain_id.t)
  (raw_operation : Tezos_raw_protocol_alpha__Alpha_context.operation A)
  (op :
    Tezos_raw_protocol_alpha.Alpha_context.contents
      (Tezos_raw_protocol_alpha.Alpha_context.Kind.manager B))
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Alpha_context.context) :=
  let
    'Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
      Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.source :=
        source;
        Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.fee :=
          fee;
        Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.counter
          := counter;
        Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.operation
          := operation;
        Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.gas_limit
          := gas_limit;
        Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.storage_limit
          := storage_limit
        |} := op in
  op_gtgteqquestion (Lwt.__return (Gas.check_limit ctxt gas_limit))
    (fun function_parameter =>
      let 'tt := function_parameter in
      let ctxt := Gas.set_limit ctxt gas_limit in
      op_gtgteqquestion
        (Lwt.__return (Fees.check_storage_limit ctxt storage_limit))
        (fun function_parameter =>
          let 'tt := function_parameter in
          op_gtgteqquestion
            (Contract.must_be_allocated ctxt (Contract.implicit_contract source))
            (fun function_parameter =>
              let 'tt := function_parameter in
              op_gtgteqquestion
                (Contract.check_counter_increment ctxt source counter)
                (fun function_parameter =>
                  let 'tt := function_parameter in
                  op_gtgteqquestion
                    match operation with
                    | Tezos_raw_protocol_alpha.Alpha_context.Reveal pk =>
                      Contract.reveal_manager_key ctxt source pk
                    |
                      Tezos_raw_protocol_alpha.Alpha_context.Transaction {|
                        Tezos_raw_protocol_alpha.Alpha_context.manager_operation.Transaction.parameters
                          := parameters
                          |} =>
                      op_gtgteqquestion
                        (op_atat Lwt.__return
                          (op_atat
                            (record_trace
                              Tezos_protocol_environment_alpha__Environment.Error_monad.Gas_quota_exceeded_init_deserialize)
                            (Gas.check_enough ctxt
                              (Script.minimal_deserialize_cost parameters))))
                        (fun function_parameter =>
                          let 'tt := function_parameter in
                          op_gtgtpipequestion
                            (op_atat
                              (trace
                                Tezos_protocol_environment_alpha__Environment.Error_monad.Gas_quota_exceeded_init_deserialize)
                              (Script.force_decode ctxt parameters))
                            (fun function_parameter =>
                              let '(_arg, ctxt) := function_parameter in
                              ctxt))
                    |
                      Tezos_raw_protocol_alpha.Alpha_context.Origination {|
                        Tezos_raw_protocol_alpha.Alpha_context.manager_operation.Origination.script :=
                          script
                          |} =>
                      op_gtgteqquestion
                        (op_atat Lwt.__return
                          (op_atat
                            (record_trace
                              Tezos_protocol_environment_alpha__Environment.Error_monad.Gas_quota_exceeded_init_deserialize)
                            (op_gtgtquestion
                              (Gas.consume ctxt
                                (Script.minimal_deserialize_cost
                                  (Tezos_raw_protocol_alpha.Alpha_context.Script.t.code
                                    script)))
                              (fun ctxt =>
                                Gas.check_enough ctxt
                                  (Script.minimal_deserialize_cost
                                    (Tezos_raw_protocol_alpha.Alpha_context.Script.t.storage
                                      script))))))
                        (fun function_parameter =>
                          let 'tt := function_parameter in
                          op_gtgteqquestion
                            (op_atat
                              (trace
                                Tezos_protocol_environment_alpha__Environment.Error_monad.Gas_quota_exceeded_init_deserialize)
                              (Script.force_decode ctxt
                                (Tezos_raw_protocol_alpha.Alpha_context.Script.t.code
                                  script)))
                            (fun function_parameter =>
                              let '(_code, ctxt) := function_parameter in
                              op_gtgtpipequestion
                                (op_atat
                                  (trace
                                    Tezos_protocol_environment_alpha__Environment.Error_monad.Gas_quota_exceeded_init_deserialize)
                                  (Script.force_decode ctxt
                                    (Tezos_raw_protocol_alpha.Alpha_context.Script.t.storage
                                      script)))
                                (fun function_parameter =>
                                  let '(_storage, ctxt) := function_parameter in
                                  ctxt)))
                    | _ => __return ctxt
                    end
                    (fun ctxt =>
                      op_gtgteqquestion (Contract.get_manager_key ctxt source)
                        (fun public_key =>
                          op_gtgteqquestion
                            (Operation.check_signature public_key chain_id
                              raw_operation)
                            (fun function_parameter =>
                              let 'tt := function_parameter in
                              op_gtgteqquestion
                                (Contract.increment_counter ctxt source)
                                (fun ctxt =>
                                  op_gtgteqquestion
                                    (Contract.spend ctxt
                                      (Contract.implicit_contract source) fee)
                                    (fun ctxt =>
                                      op_gtgteqquestion (add_fees ctxt fee)
                                        (fun ctxt => __return ctxt)))))))))).

Definition apply_manager_contents {A : Set}
  (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
  (mode : Tezos_raw_protocol_alpha.Script_ir_translator.unparsing_mode)
  (chain_id : Tezos_protocol_environment_alpha__Environment.Chain_id.t)
  (op :
    Tezos_raw_protocol_alpha.Alpha_context.contents
      (Tezos_raw_protocol_alpha.Alpha_context.Kind.manager A))
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (((* `Failure *) unit +
      (* `Success *) Tezos_raw_protocol_alpha.Alpha_context.context) *
      Tezos_raw_protocol_alpha.Apply_results.manager_operation_result A *
      list
        Tezos_raw_protocol_alpha.Apply_results.packed_internal_operation_result) :=
  let
    'Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
      Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.source :=
        source;
        Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.operation
          := operation;
        Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.gas_limit
          := gas_limit;
        Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.storage_limit
          := storage_limit
        |} := op in
  let ctxt := Gas.set_limit ctxt gas_limit in
  let ctxt := Fees.start_counting_storage_fees ctxt in
  let source := Contract.implicit_contract source in
  op_gtgteq
    (apply_manager_operation_content ctxt mode source source chain_id false
      operation)
    (fun function_parameter =>
      match function_parameter with
      |
        Tezos_protocol_environment_alpha__Environment.Pervasives.Ok
          (ctxt, operation_results, internal_operations) =>
        op_gtgteq
          (apply_internal_manager_operations ctxt mode source chain_id
            internal_operations)
          (fun function_parameter =>
            match function_parameter with
            | (Success ctxt, internal_operations_results) =>
              op_gtgteq (Fees.burn_storage_fees ctxt storage_limit source)
                (fun function_parameter =>
                  match function_parameter with
                  |
                    Tezos_protocol_environment_alpha__Environment.Pervasives.Ok
                      ctxt =>
                    Lwt.__return
                      ((* ❌ Variants not supported *)
                      variant,
                        (Tezos_raw_protocol_alpha.Apply_results.Applied
                          operation_results), internal_operations_results)
                  |
                    Tezos_protocol_environment_alpha__Environment.Pervasives.Error
                      errors =>
                    Lwt.__return
                      ((* ❌ Variants not supported *)
                      variant,
                        (Tezos_raw_protocol_alpha.Apply_results.Backtracked
                          operation_results (Some errors)),
                        internal_operations_results)
                  end)
            | (Failure, internal_operations_results) =>
              Lwt.__return
                ((* ❌ Variants not supported *)
                variant,
                  (Tezos_raw_protocol_alpha.Apply_results.Applied
                    operation_results), internal_operations_results)
            end)
      | Tezos_protocol_environment_alpha__Environment.Pervasives.Error errors =>
        Lwt.__return
          ((* ❌ Variants not supported *)
          variant,
            (Tezos_raw_protocol_alpha.Apply_results.Failed
              (manager_kind operation) errors), [])
      end).

Definition skipped_operation_result {kind : Set}
  (operation : Tezos_raw_protocol_alpha.Alpha_context.manager_operation kind)
  : Tezos_raw_protocol_alpha.Apply_results.manager_operation_result kind :=
  match operation with
  | Tezos_raw_protocol_alpha.Alpha_context.Reveal _ =>
    Tezos_raw_protocol_alpha.Apply_results.Applied
      (Tezos_raw_protocol_alpha.Apply_results.Reveal_result
        {|
          Tezos_raw_protocol_alpha.Apply_results.successful_manager_operation_result.Reveal_result.consumed_gas :=
            Z.zero |})
  | _ => Tezos_raw_protocol_alpha.Apply_results.Skipped (manager_kind operation)
  end.

Fixpoint mark_skipped {kind : Set}
  (baker :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  (level : Tezos_raw_protocol_alpha.Alpha_context.Level.t)
  (function_parameter :
    Tezos_raw_protocol_alpha.Alpha_context.contents_list
      (Tezos_raw_protocol_alpha.Alpha_context.Kind.manager kind))
  : Tezos_raw_protocol_alpha.Apply_results.contents_result_list
    (Tezos_raw_protocol_alpha.Alpha_context.Kind.manager kind) :=
  match function_parameter with
  |
    Tezos_raw_protocol_alpha.Alpha_context.Single
      (Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
        Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.source :=
          source;
          Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.fee
            := fee;
          Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.operation
            := operation
          |}) =>
    let source := Contract.implicit_contract source in
    Tezos_raw_protocol_alpha.Apply_results.Single_result
      (Tezos_raw_protocol_alpha.Apply_results.Manager_operation_result
        {|
          Tezos_raw_protocol_alpha.Apply_results.contents_result.Manager_operation_result.balance_updates :=
            Delegate.cleanup_balance_updates
              (cons
                ((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Contract
                  source),
                  (Tezos_raw_protocol_alpha.Alpha_context.Delegate.Debited fee))
                (cons
                  ((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Fees baker
                    (Tezos_raw_protocol_alpha.Alpha_context.Level.t.cycle level)),
                    (Tezos_raw_protocol_alpha.Alpha_context.Delegate.Credited
                      fee)) []));
          Tezos_raw_protocol_alpha.Apply_results.contents_result.Manager_operation_result.operation_result :=
            skipped_operation_result operation;
          Tezos_raw_protocol_alpha.Apply_results.contents_result.Manager_operation_result.internal_operation_results :=
            [] |})
  |
    Tezos_raw_protocol_alpha.Alpha_context.Cons
      (Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
        Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.source :=
          source;
          Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.fee
            := fee;
          Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.operation
            := operation
          |}) rest =>
    let source := Contract.implicit_contract source in
    Tezos_raw_protocol_alpha.Apply_results.Cons_result
      (Tezos_raw_protocol_alpha.Apply_results.Manager_operation_result
        {|
          Tezos_raw_protocol_alpha.Apply_results.contents_result.Manager_operation_result.balance_updates :=
            Delegate.cleanup_balance_updates
              (cons
                ((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Contract
                  source),
                  (Tezos_raw_protocol_alpha.Alpha_context.Delegate.Debited fee))
                (cons
                  ((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Fees baker
                    (Tezos_raw_protocol_alpha.Alpha_context.Level.t.cycle level)),
                    (Tezos_raw_protocol_alpha.Alpha_context.Delegate.Credited
                      fee)) []));
          Tezos_raw_protocol_alpha.Apply_results.contents_result.Manager_operation_result.operation_result :=
            skipped_operation_result operation;
          Tezos_raw_protocol_alpha.Apply_results.contents_result.Manager_operation_result.internal_operation_results :=
            [] |}) (mark_skipped baker level rest)
  end.

Fixpoint precheck_manager_contents_list {A kind : Set}
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.t)
  (chain_id : Tezos_protocol_environment_alpha__Environment.Chain_id.t)
  (raw_operation : Tezos_raw_protocol_alpha.Alpha_context.Operation.t A)
  (contents_list :
    Tezos_raw_protocol_alpha.Alpha_context.contents_list
      (Tezos_raw_protocol_alpha.Alpha_context.Kind.manager kind))
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Alpha_context.context) :=
  match contents_list with
  |
    Tezos_raw_protocol_alpha.Alpha_context.Single
      ((Tezos_raw_protocol_alpha.Alpha_context.Manager_operation _) as op) =>
    precheck_manager_contents ctxt chain_id raw_operation op
  |
    Tezos_raw_protocol_alpha.Alpha_context.Cons
      ((Tezos_raw_protocol_alpha.Alpha_context.Manager_operation _) as op) rest
    =>
    op_gtgteqquestion (precheck_manager_contents ctxt chain_id raw_operation op)
      (fun ctxt =>
        precheck_manager_contents_list ctxt chain_id raw_operation rest)
  end.

Fixpoint apply_manager_contents_list_rec {kind : Set}
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.t)
  (mode : Tezos_raw_protocol_alpha.Script_ir_translator.unparsing_mode)
  (baker : Tezos_raw_protocol_alpha.Alpha_context.public_key_hash)
  (chain_id : Tezos_protocol_environment_alpha__Environment.Chain_id.t)
  (contents_list :
    Tezos_raw_protocol_alpha.Alpha_context.contents_list
      (Tezos_raw_protocol_alpha.Alpha_context.Kind.manager kind))
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (((* `Failure *) unit +
      (* `Success *) Tezos_raw_protocol_alpha.Alpha_context.context) *
      Tezos_raw_protocol_alpha.Apply_results.contents_result_list
        (Tezos_raw_protocol_alpha.Alpha_context.Kind.manager kind)) :=
  let level := Level.current ctxt in
  match contents_list with
  |
    Tezos_raw_protocol_alpha.Alpha_context.Single
      ((Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
        Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.source :=
          source;
          Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.fee
            := fee
          |}) as op) =>
    let source := Contract.implicit_contract source in
    op_gtgteq (apply_manager_contents ctxt mode chain_id op)
      (fun function_parameter =>
        let '(ctxt_result, operation_result, internal_operation_results) :=
          function_parameter in
        let __result_value :=
          Tezos_raw_protocol_alpha.Apply_results.Manager_operation_result
            {|
              Tezos_raw_protocol_alpha.Apply_results.contents_result.Manager_operation_result.balance_updates :=
                Delegate.cleanup_balance_updates
                  (cons
                    ((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Contract
                      source),
                      (Tezos_raw_protocol_alpha.Alpha_context.Delegate.Debited
                        fee))
                    (cons
                      ((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Fees
                        baker
                        (Tezos_raw_protocol_alpha.Alpha_context.Level.t.cycle
                          level)),
                        (Tezos_raw_protocol_alpha.Alpha_context.Delegate.Credited
                          fee)) []));
              Tezos_raw_protocol_alpha.Apply_results.contents_result.Manager_operation_result.operation_result :=
                operation_result;
              Tezos_raw_protocol_alpha.Apply_results.contents_result.Manager_operation_result.internal_operation_results :=
                internal_operation_results |} in
        Lwt.__return
          (ctxt_result,
            (Tezos_raw_protocol_alpha.Apply_results.Single_result __result_value)))
  |
    Tezos_raw_protocol_alpha.Alpha_context.Cons
      ((Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
        Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.source :=
          source;
          Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.fee
            := fee
          |}) as op) rest =>
    let source := Contract.implicit_contract source in
    op_gtgteq (apply_manager_contents ctxt mode chain_id op)
      (fun function_parameter =>
        match function_parameter with
        | (Failure, operation_result, internal_operation_results) =>
          let __result_value :=
            Tezos_raw_protocol_alpha.Apply_results.Manager_operation_result
              {|
                Tezos_raw_protocol_alpha.Apply_results.contents_result.Manager_operation_result.balance_updates :=
                  Delegate.cleanup_balance_updates
                    (cons
                      ((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Contract
                        source),
                        (Tezos_raw_protocol_alpha.Alpha_context.Delegate.Debited
                          fee))
                      (cons
                        ((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Fees
                          baker
                          (Tezos_raw_protocol_alpha.Alpha_context.Level.t.cycle
                            level)),
                          (Tezos_raw_protocol_alpha.Alpha_context.Delegate.Credited
                            fee)) []));
                Tezos_raw_protocol_alpha.Apply_results.contents_result.Manager_operation_result.operation_result :=
                  operation_result;
                Tezos_raw_protocol_alpha.Apply_results.contents_result.Manager_operation_result.internal_operation_results :=
                  internal_operation_results |} in
          Lwt.__return
            ((* ❌ Variants not supported *)
            variant,
              (Tezos_raw_protocol_alpha.Apply_results.Cons_result __result_value
                (mark_skipped baker level rest)))
        | (Success ctxt, operation_result, internal_operation_results) =>
          let __result_value :=
            Tezos_raw_protocol_alpha.Apply_results.Manager_operation_result
              {|
                Tezos_raw_protocol_alpha.Apply_results.contents_result.Manager_operation_result.balance_updates :=
                  Delegate.cleanup_balance_updates
                    (cons
                      ((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Contract
                        source),
                        (Tezos_raw_protocol_alpha.Alpha_context.Delegate.Debited
                          fee))
                      (cons
                        ((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Fees
                          baker
                          (Tezos_raw_protocol_alpha.Alpha_context.Level.t.cycle
                            level)),
                          (Tezos_raw_protocol_alpha.Alpha_context.Delegate.Credited
                            fee)) []));
                Tezos_raw_protocol_alpha.Apply_results.contents_result.Manager_operation_result.operation_result :=
                  operation_result;
                Tezos_raw_protocol_alpha.Apply_results.contents_result.Manager_operation_result.internal_operation_results :=
                  internal_operation_results |} in
          op_gtgteq
            (apply_manager_contents_list_rec ctxt mode baker chain_id rest)
            (fun function_parameter =>
              let '(ctxt_result, results) := function_parameter in
              Lwt.__return
                (ctxt_result,
                  (Tezos_raw_protocol_alpha.Apply_results.Cons_result
                    __result_value results)))
        end)
  end.

Definition mark_backtracked {A : Set}
  (results :
    Tezos_raw_protocol_alpha.Apply_results.contents_result_list
      (Tezos_raw_protocol_alpha.Alpha_context.Kind.manager A))
  : Tezos_raw_protocol_alpha.Apply_results.contents_result_list
    (Tezos_raw_protocol_alpha.Alpha_context.Kind.manager A) :=
  let fix mark_contents_list {kind : Set}
    (function_parameter :
    Tezos_raw_protocol_alpha.Apply_results.contents_result_list
      (Tezos_raw_protocol_alpha.Alpha_context.Kind.manager kind))
    : Tezos_raw_protocol_alpha.Apply_results.contents_result_list
      (Tezos_raw_protocol_alpha.Alpha_context.Kind.manager kind) :=
    match function_parameter with
    |
      Tezos_raw_protocol_alpha.Apply_results.Single_result
        (Tezos_raw_protocol_alpha.Apply_results.Manager_operation_result op) =>
      Tezos_raw_protocol_alpha.Apply_results.Single_result
        (Tezos_raw_protocol_alpha.Apply_results.Manager_operation_result
          {|
            Tezos_raw_protocol_alpha.Apply_results.contents_result.Manager_operation_result.balance_updates :=
              Tezos_raw_protocol_alpha.Apply_results.contents_result.Manager_operation_result.balance_updates
                op;
            Tezos_raw_protocol_alpha.Apply_results.contents_result.Manager_operation_result.operation_result :=
              mark_manager_operation_result
                (Tezos_raw_protocol_alpha.Apply_results.contents_result.Manager_operation_result.operation_result
                  op);
            Tezos_raw_protocol_alpha.Apply_results.contents_result.Manager_operation_result.internal_operation_results :=
              List.map mark_internal_operation_results
                (Tezos_raw_protocol_alpha.Apply_results.contents_result.Manager_operation_result.internal_operation_results
                  op) |})
    |
      Tezos_raw_protocol_alpha.Apply_results.Cons_result
        (Tezos_raw_protocol_alpha.Apply_results.Manager_operation_result op)
        rest =>
      Tezos_raw_protocol_alpha.Apply_results.Cons_result
        (Tezos_raw_protocol_alpha.Apply_results.Manager_operation_result
          {|
            Tezos_raw_protocol_alpha.Apply_results.contents_result.Manager_operation_result.balance_updates :=
              Tezos_raw_protocol_alpha.Apply_results.contents_result.Manager_operation_result.balance_updates
                op;
            Tezos_raw_protocol_alpha.Apply_results.contents_result.Manager_operation_result.operation_result :=
              mark_manager_operation_result
                (Tezos_raw_protocol_alpha.Apply_results.contents_result.Manager_operation_result.operation_result
                  op);
            Tezos_raw_protocol_alpha.Apply_results.contents_result.Manager_operation_result.internal_operation_results :=
              List.map mark_internal_operation_results
                (Tezos_raw_protocol_alpha.Apply_results.contents_result.Manager_operation_result.internal_operation_results
                  op) |}) (mark_contents_list rest)
    end
  with mark_internal_operation_results
    (function_parameter :
    Tezos_raw_protocol_alpha.Apply_results.packed_internal_operation_result)
    : Tezos_raw_protocol_alpha.Apply_results.packed_internal_operation_result :=
    let
      'Tezos_raw_protocol_alpha.Apply_results.Internal_operation_result kind
        __result_value := function_parameter in
    Tezos_raw_protocol_alpha.Apply_results.Internal_operation_result kind
      (mark_manager_operation_result __result_value)
  with mark_manager_operation_result {kind : Set}
    (function_parameter :
    Tezos_raw_protocol_alpha.Apply_results.manager_operation_result kind)
    : Tezos_raw_protocol_alpha.Apply_results.manager_operation_result kind :=
    match function_parameter with
    |
      (Tezos_raw_protocol_alpha.Apply_results.Failed _ _ |
        Tezos_raw_protocol_alpha.Apply_results.Skipped _ |
        Tezos_raw_protocol_alpha.Apply_results.Backtracked _ _) as
        __result_value => __result_value
    |
      (Tezos_raw_protocol_alpha.Apply_results.Applied
        (Tezos_raw_protocol_alpha.Apply_results.Reveal_result _)) as
        __result_value => __result_value
    | Tezos_raw_protocol_alpha.Apply_results.Applied __result_value =>
      Tezos_raw_protocol_alpha.Apply_results.Backtracked __result_value None
    end in
  mark_contents_list results.

Definition apply_manager_contents_list {A : Set}
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.t)
  (mode : Tezos_raw_protocol_alpha.Script_ir_translator.unparsing_mode)
  (baker : Tezos_raw_protocol_alpha.Alpha_context.public_key_hash)
  (chain_id : Tezos_protocol_environment_alpha__Environment.Chain_id.t)
  (contents_list :
    Tezos_raw_protocol_alpha.Alpha_context.contents_list
      (Tezos_raw_protocol_alpha.Alpha_context.Kind.manager A))
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_raw_protocol_alpha.Alpha_context.t *
      Tezos_raw_protocol_alpha.Apply_results.contents_result_list
        (Tezos_raw_protocol_alpha.Alpha_context.Kind.manager A)) :=
  op_gtgteq
    (apply_manager_contents_list_rec ctxt mode baker chain_id contents_list)
    (fun function_parameter =>
      let '(ctxt_result, results) := function_parameter in
      match ctxt_result with
      | Failure => Lwt.__return (ctxt, (mark_backtracked results))
      | Success ctxt =>
        op_gtgteq (Big_map.cleanup_temporary ctxt)
          (fun ctxt => Lwt.__return (ctxt, results))
      end).

Definition apply_contents_list {A : Set}
  (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
  (chain_id : Tezos_protocol_environment_alpha__Environment.Chain_id.t)
  (mode : Tezos_raw_protocol_alpha.Script_ir_translator.unparsing_mode)
  (pred_block : Tezos_protocol_environment_alpha__Environment.Block_hash.t)
  (baker :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  (operation : Tezos_raw_protocol_alpha.Alpha_context.operation A)
  (contents_list : Tezos_raw_protocol_alpha.Alpha_context.contents_list A)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Alpha_context.context *
        Tezos_raw_protocol_alpha.Apply_results.contents_result_list A)) :=
  match contents_list with
  |
    Tezos_raw_protocol_alpha.Alpha_context.Single
      (Tezos_raw_protocol_alpha.Alpha_context.Endorsement {|
        Tezos_raw_protocol_alpha.Alpha_context.contents.Endorsement.level := level
          |}) =>
    let block :=
      Tezos_protocol_environment_alpha__Environment.Operation.shell_header.branch
        (Tezos_raw_protocol_alpha.Alpha_context.operation.shell operation) in
    op_gtgteqquestion
      (fail_unless (Block_hash.equal block pred_block)
        (Tezos_protocol_environment_alpha__Environment.Error_monad.Wrong_endorsement_predecessor
          pred_block block))
      (fun function_parameter =>
        let 'tt := function_parameter in
        let current_level :=
          Tezos_raw_protocol_alpha.Alpha_context.Level.t.level
            (Level.current ctxt) in
        op_gtgteqquestion
          (fail_unless (op_eq (succ level) current_level)
            Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_endorsement_level)
          (fun function_parameter =>
            let 'tt := function_parameter in
            op_gtgteqquestion
              (Baking.check_endorsement_rights ctxt chain_id operation)
              (fun function_parameter =>
                let '(delegate, slots, used) := function_parameter in
                if used then
                  fail
                    (Tezos_protocol_environment_alpha__Environment.Error_monad.Duplicate_endorsement
                      delegate)
                else
                  let ctxt := record_endorsement ctxt delegate in
                  let gap := List.length slots in
                  op_gtgteqquestion
                    (Lwt.__return
                      (op_starquestion
                        (Constants.endorsement_security_deposit ctxt)
                        (Int64.of_int gap)))
                    (fun deposit =>
                      op_gtgteqquestion
                        (Delegate.freeze_deposit ctxt delegate deposit)
                        (fun ctxt =>
                          op_gtgteqquestion (Global.get_block_priority ctxt)
                            (fun block_priority =>
                              op_gtgteqquestion
                                (Baking.endorsing_reward ctxt block_priority gap)
                                (fun reward =>
                                  op_gtgteqquestion
                                    (Delegate.freeze_rewards ctxt delegate
                                      reward)
                                    (fun ctxt =>
                                      let level :=
                                        Level.from_raw ctxt None level in
                                      __return
                                        (ctxt,
                                          (Tezos_raw_protocol_alpha.Apply_results.Single_result
                                            (Tezos_raw_protocol_alpha.Apply_results.Endorsement_result
                                              {|
                                                Tezos_raw_protocol_alpha.Apply_results.contents_result.Endorsement_result.balance_updates :=
                                                  Delegate.cleanup_balance_updates
                                                    (cons
                                                      ((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Contract
                                                        (Contract.implicit_contract
                                                          delegate)),
                                                        (Tezos_raw_protocol_alpha.Alpha_context.Delegate.Debited
                                                          deposit))
                                                      (cons
                                                        ((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Deposits
                                                          delegate
                                                          (Tezos_raw_protocol_alpha.Alpha_context.Level.t.cycle
                                                            level)),
                                                          (Tezos_raw_protocol_alpha.Alpha_context.Delegate.Credited
                                                            deposit))
                                                        (cons
                                                          ((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Rewards
                                                            delegate
                                                            (Tezos_raw_protocol_alpha.Alpha_context.Level.t.cycle
                                                              level)),
                                                            (Tezos_raw_protocol_alpha.Alpha_context.Delegate.Credited
                                                              reward)) [])));
                                                Tezos_raw_protocol_alpha.Apply_results.contents_result.Endorsement_result.delegate :=
                                                  delegate;
                                                Tezos_raw_protocol_alpha.Apply_results.contents_result.Endorsement_result.slots :=
                                                  slots |})))))))))))
  |
    Tezos_raw_protocol_alpha.Alpha_context.Single
      (Tezos_raw_protocol_alpha.Alpha_context.Seed_nonce_revelation {|
        Tezos_raw_protocol_alpha.Alpha_context.contents.Seed_nonce_revelation.level :=
          level;
          Tezos_raw_protocol_alpha.Alpha_context.contents.Seed_nonce_revelation.nonce
            := nonce
          |}) =>
    let level := Level.from_raw ctxt None level in
    op_gtgteqquestion (Nonce.reveal ctxt level nonce)
      (fun ctxt =>
        let seed_nonce_revelation_tip :=
          Constants.seed_nonce_revelation_tip ctxt in
        op_gtgteqquestion (add_rewards ctxt seed_nonce_revelation_tip)
          (fun ctxt =>
            __return
              (ctxt,
                (Tezos_raw_protocol_alpha.Apply_results.Single_result
                  (Tezos_raw_protocol_alpha.Apply_results.Seed_nonce_revelation_result
                    (cons
                      ((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Rewards
                        baker
                        (Tezos_raw_protocol_alpha.Alpha_context.Level.t.cycle
                          level)),
                        (Tezos_raw_protocol_alpha.Alpha_context.Delegate.Credited
                          seed_nonce_revelation_tip)) []))))))
  |
    Tezos_raw_protocol_alpha.Alpha_context.Single
      (Tezos_raw_protocol_alpha.Alpha_context.Double_endorsement_evidence {|
        Tezos_raw_protocol_alpha.Alpha_context.contents.Double_endorsement_evidence.op1
          := op1;
          Tezos_raw_protocol_alpha.Alpha_context.contents.Double_endorsement_evidence.op2
            := op2
          |}) =>
    match
      ((Tezos_raw_protocol_alpha.Alpha_context.protocol_data.contents
        (Tezos_raw_protocol_alpha.Alpha_context.operation.protocol_data op1)),
        (Tezos_raw_protocol_alpha.Alpha_context.protocol_data.contents
          (Tezos_raw_protocol_alpha.Alpha_context.operation.protocol_data op2)))
      with
    |
      (Tezos_raw_protocol_alpha.Alpha_context.Single
        (Tezos_raw_protocol_alpha.Alpha_context.Endorsement e1),
        Tezos_raw_protocol_alpha.Alpha_context.Single
          (Tezos_raw_protocol_alpha.Alpha_context.Endorsement e2)) =>
      let level :=
        Level.from_raw ctxt None
          (Tezos_raw_protocol_alpha.Alpha_context.contents.Endorsement.level e1)
        in
      let oldest_level := Level.last_allowed_fork_level ctxt in
      op_gtgteqquestion
        (fail_unless (op_lt level (Level.current ctxt))
          (Tezos_protocol_environment_alpha__Environment.Error_monad.Too_early_double_endorsement_evidence
            {|
              Too_early_double_endorsement_evidence.level :=
                Tezos_raw_protocol_alpha.Alpha_context.Level.t.level level;
              Too_early_double_endorsement_evidence.current :=
                Tezos_raw_protocol_alpha.Alpha_context.Level.t.level
                  (Level.current ctxt) |}))
        (fun function_parameter =>
          let 'tt := function_parameter in
          op_gtgteqquestion
            (fail_unless
              (op_lteq oldest_level
                (Tezos_raw_protocol_alpha.Alpha_context.Level.t.level level))
              (Tezos_protocol_environment_alpha__Environment.Error_monad.Outdated_double_endorsement_evidence
                {|
                  Outdated_double_endorsement_evidence.level :=
                    Tezos_raw_protocol_alpha.Alpha_context.Level.t.level level;
                  Outdated_double_endorsement_evidence.last := oldest_level |}))
            (fun function_parameter =>
              let 'tt := function_parameter in
              op_gtgteqquestion
                (Baking.check_endorsement_rights ctxt chain_id op1)
                (fun function_parameter =>
                  let '(delegate1, _, _) := function_parameter in
                  op_gtgteqquestion
                    (Baking.check_endorsement_rights ctxt chain_id op2)
                    (fun function_parameter =>
                      let '(delegate2, _, _) := function_parameter in
                      op_gtgteqquestion
                        (fail_unless
                          (Signature.Public_key_hash.equal delegate1 delegate2)
                          (Tezos_protocol_environment_alpha__Environment.Error_monad.Inconsistent_double_endorsement_evidence
                            {|
                              Inconsistent_double_endorsement_evidence.delegate1 :=
                                delegate1;
                              Inconsistent_double_endorsement_evidence.delegate2 :=
                                delegate2 |}))
                        (fun function_parameter =>
                          let 'tt := function_parameter in
                          op_gtgteqquestion
                            (Delegate.has_frozen_balance ctxt delegate1
                              (Tezos_raw_protocol_alpha.Alpha_context.Level.t.cycle
                                level))
                            (fun valid =>
                              op_gtgteqquestion
                                (fail_unless valid
                                  Tezos_protocol_environment_alpha__Environment.Error_monad.Unrequired_double_endorsement_evidence)
                                (fun function_parameter =>
                                  let 'tt := function_parameter in
                                  op_gtgteqquestion
                                    (Delegate.punish ctxt delegate1
                                      (Tezos_raw_protocol_alpha.Alpha_context.Level.t.cycle
                                        level))
                                    (fun function_parameter =>
                                      let '(ctxt, balance) := function_parameter
                                        in
                                      op_gtgteqquestion
                                        (Lwt.__return
                                          (op_plusquestion
                                            (Tezos_raw_protocol_alpha.Alpha_context.Delegate.frozen_balance.deposit
                                              balance)
                                            (Tezos_raw_protocol_alpha.Alpha_context.Delegate.frozen_balance.fees
                                              balance)))
                                        (fun burned =>
                                          let reward :=
                                            match
                                              op_divquestion burned
                                                (* ❌ Constant of type int64 is converted to int *)
                                                2 with
                                            |
                                              Tezos_protocol_environment_alpha__Environment.Pervasives.Ok
                                                v => v
                                            |
                                              Tezos_protocol_environment_alpha__Environment.Pervasives.Error
                                                _ => Tez.zero
                                            end in
                                          op_gtgteqquestion
                                            (add_rewards ctxt reward)
                                            (fun ctxt =>
                                              let current_cycle :=
                                                Tezos_raw_protocol_alpha.Alpha_context.Level.t.cycle
                                                  (Level.current ctxt) in
                                              __return
                                                (ctxt,
                                                  (Tezos_raw_protocol_alpha.Apply_results.Single_result
                                                    (Tezos_raw_protocol_alpha.Apply_results.Double_endorsement_evidence_result
                                                      (Delegate.cleanup_balance_updates
                                                        (cons
                                                          ((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Deposits
                                                            delegate1
                                                            (Tezos_raw_protocol_alpha.Alpha_context.Level.t.cycle
                                                              level)),
                                                            (Tezos_raw_protocol_alpha.Alpha_context.Delegate.Debited
                                                              (Tezos_raw_protocol_alpha.Alpha_context.Delegate.frozen_balance.deposit
                                                                balance)))
                                                          (cons
                                                            ((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Fees
                                                              delegate1
                                                              (Tezos_raw_protocol_alpha.Alpha_context.Level.t.cycle
                                                                level)),
                                                              (Tezos_raw_protocol_alpha.Alpha_context.Delegate.Debited
                                                                (Tezos_raw_protocol_alpha.Alpha_context.Delegate.frozen_balance.fees
                                                                  balance)))
                                                            (cons
                                                              ((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Rewards
                                                                delegate1
                                                                (Tezos_raw_protocol_alpha.Alpha_context.Level.t.cycle
                                                                  level)),
                                                                (Tezos_raw_protocol_alpha.Alpha_context.Delegate.Debited
                                                                  (Tezos_raw_protocol_alpha.Alpha_context.Delegate.frozen_balance.rewards
                                                                    balance)))
                                                              (cons
                                                                ((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Rewards
                                                                  baker
                                                                  current_cycle),
                                                                  (Tezos_raw_protocol_alpha.Alpha_context.Delegate.Credited
                                                                    reward)) []))))))))))))))))))
    | (_, _) =>
      fail
        Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_double_endorsement_evidence
    end
  |
    Tezos_raw_protocol_alpha.Alpha_context.Single
      (Tezos_raw_protocol_alpha.Alpha_context.Double_baking_evidence {|
        Tezos_raw_protocol_alpha.Alpha_context.contents.Double_baking_evidence.bh1 :=
          bh1;
          Tezos_raw_protocol_alpha.Alpha_context.contents.Double_baking_evidence.bh2
            := bh2
          |}) =>
    let hash1 := Block_header.__hash_value bh1 in
    let hash2 := Block_header.__hash_value bh2 in
    op_gtgteqquestion
      (fail_unless
        (op_andand
          (op_eq
            (Tezos_protocol_environment_alpha__Environment.Block_header.shell_header.level
              (Tezos_raw_protocol_alpha.Alpha_context.Block_header.t.shell bh1))
            (Tezos_protocol_environment_alpha__Environment.Block_header.shell_header.level
              (Tezos_raw_protocol_alpha.Alpha_context.Block_header.t.shell bh2)))
          (not (Block_hash.equal hash1 hash2)))
        (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_double_baking_evidence
          {| Invalid_double_baking_evidence.hash1 := hash1;
            Invalid_double_baking_evidence.level1 :=
              Tezos_protocol_environment_alpha__Environment.Block_header.shell_header.level
                (Tezos_raw_protocol_alpha.Alpha_context.Block_header.t.shell bh1);
            Invalid_double_baking_evidence.hash2 := hash2;
            Invalid_double_baking_evidence.level2 :=
              Tezos_protocol_environment_alpha__Environment.Block_header.shell_header.level
                (Tezos_raw_protocol_alpha.Alpha_context.Block_header.t.shell bh2)
            |}))
      (fun function_parameter =>
        let 'tt := function_parameter in
        op_gtgteqquestion
          (Lwt.__return
            (Raw_level.of_int32
              (Tezos_protocol_environment_alpha__Environment.Block_header.shell_header.level
                (Tezos_raw_protocol_alpha.Alpha_context.Block_header.t.shell bh1))))
          (fun raw_level =>
            let oldest_level := Level.last_allowed_fork_level ctxt in
            op_gtgteqquestion
              (fail_unless
                (op_lt raw_level
                  (Tezos_raw_protocol_alpha.Alpha_context.Level.t.level
                    (Level.current ctxt)))
                (Tezos_protocol_environment_alpha__Environment.Error_monad.Too_early_double_baking_evidence
                  {| Too_early_double_baking_evidence.level := raw_level;
                    Too_early_double_baking_evidence.current :=
                      Tezos_raw_protocol_alpha.Alpha_context.Level.t.level
                        (Level.current ctxt) |}))
              (fun function_parameter =>
                let 'tt := function_parameter in
                op_gtgteqquestion
                  (fail_unless (op_lteq oldest_level raw_level)
                    (Tezos_protocol_environment_alpha__Environment.Error_monad.Outdated_double_baking_evidence
                      {| Outdated_double_baking_evidence.level := raw_level;
                        Outdated_double_baking_evidence.last := oldest_level |}))
                  (fun function_parameter =>
                    let 'tt := function_parameter in
                    let level := Level.from_raw ctxt None raw_level in
                    op_gtgteqquestion
                      (Roll.baking_rights_owner ctxt level
                        (Tezos_raw_protocol_alpha.Alpha_context.Block_header.contents.priority
                          (Tezos_raw_protocol_alpha.Alpha_context.Block_header.protocol_data.contents
                            (Tezos_raw_protocol_alpha.Alpha_context.Block_header.t.protocol_data
                              bh1))))
                      (fun delegate1 =>
                        op_gtgteqquestion
                          (Baking.check_signature bh1 chain_id delegate1)
                          (fun function_parameter =>
                            let 'tt := function_parameter in
                            op_gtgteqquestion
                              (Roll.baking_rights_owner ctxt level
                                (Tezos_raw_protocol_alpha.Alpha_context.Block_header.contents.priority
                                  (Tezos_raw_protocol_alpha.Alpha_context.Block_header.protocol_data.contents
                                    (Tezos_raw_protocol_alpha.Alpha_context.Block_header.t.protocol_data
                                      bh2))))
                              (fun delegate2 =>
                                op_gtgteqquestion
                                  (Baking.check_signature bh2 chain_id delegate2)
                                  (fun function_parameter =>
                                    let 'tt := function_parameter in
                                    op_gtgteqquestion
                                      (fail_unless
                                        (Signature.Public_key.equal delegate1
                                          delegate2)
                                        (Tezos_protocol_environment_alpha__Environment.Error_monad.Inconsistent_double_baking_evidence
                                          {|
                                            Inconsistent_double_baking_evidence.delegate1 :=
                                              Signature.Public_key.__hash_value
                                                delegate1;
                                            Inconsistent_double_baking_evidence.delegate2 :=
                                              Signature.Public_key.__hash_value
                                                delegate2 |}))
                                      (fun function_parameter =>
                                        let 'tt := function_parameter in
                                        let delegate :=
                                          Signature.Public_key.__hash_value
                                            delegate1 in
                                        op_gtgteqquestion
                                          (Delegate.has_frozen_balance ctxt
                                            delegate
                                            (Tezos_raw_protocol_alpha.Alpha_context.Level.t.cycle
                                              level))
                                          (fun valid =>
                                            op_gtgteqquestion
                                              (fail_unless valid
                                                Tezos_protocol_environment_alpha__Environment.Error_monad.Unrequired_double_baking_evidence)
                                              (fun function_parameter =>
                                                let 'tt := function_parameter in
                                                op_gtgteqquestion
                                                  (Delegate.punish ctxt delegate
                                                    (Tezos_raw_protocol_alpha.Alpha_context.Level.t.cycle
                                                      level))
                                                  (fun function_parameter =>
                                                    let '(ctxt, balance) :=
                                                      function_parameter in
                                                    op_gtgteqquestion
                                                      (Lwt.__return
                                                        (op_plusquestion
                                                          (Tezos_raw_protocol_alpha.Alpha_context.Delegate.frozen_balance.deposit
                                                            balance)
                                                          (Tezos_raw_protocol_alpha.Alpha_context.Delegate.frozen_balance.fees
                                                            balance)))
                                                      (fun burned =>
                                                        let reward :=
                                                          match
                                                            op_divquestion
                                                              burned
                                                              (* ❌ Constant of type int64 is converted to int *)
                                                              2 with
                                                          |
                                                            Tezos_protocol_environment_alpha__Environment.Pervasives.Ok
                                                              v => v
                                                          |
                                                            Tezos_protocol_environment_alpha__Environment.Pervasives.Error
                                                              _ => Tez.zero
                                                          end in
                                                        op_gtgteqquestion
                                                          (add_rewards ctxt
                                                            reward)
                                                          (fun ctxt =>
                                                            let current_cycle :=
                                                              Tezos_raw_protocol_alpha.Alpha_context.Level.t.cycle
                                                                (Level.current
                                                                  ctxt) in
                                                            __return
                                                              (ctxt,
                                                                (Tezos_raw_protocol_alpha.Apply_results.Single_result
                                                                  (Tezos_raw_protocol_alpha.Apply_results.Double_baking_evidence_result
                                                                    (Delegate.cleanup_balance_updates
                                                                      (cons
                                                                        ((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Deposits
                                                                          delegate
                                                                          (Tezos_raw_protocol_alpha.Alpha_context.Level.t.cycle
                                                                            level)),
                                                                          (Tezos_raw_protocol_alpha.Alpha_context.Delegate.Debited
                                                                            (Tezos_raw_protocol_alpha.Alpha_context.Delegate.frozen_balance.deposit
                                                                              balance)))
                                                                        (cons
                                                                          ((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Fees
                                                                            delegate
                                                                            (Tezos_raw_protocol_alpha.Alpha_context.Level.t.cycle
                                                                              level)),
                                                                            (Tezos_raw_protocol_alpha.Alpha_context.Delegate.Debited
                                                                              (Tezos_raw_protocol_alpha.Alpha_context.Delegate.frozen_balance.fees
                                                                                balance)))
                                                                          (cons
                                                                            ((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Rewards
                                                                              delegate
                                                                              (Tezos_raw_protocol_alpha.Alpha_context.Level.t.cycle
                                                                                level)),
                                                                              (Tezos_raw_protocol_alpha.Alpha_context.Delegate.Debited
                                                                                (Tezos_raw_protocol_alpha.Alpha_context.Delegate.frozen_balance.rewards
                                                                                  balance)))
                                                                            (cons
                                                                              ((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Rewards
                                                                                baker
                                                                                current_cycle),
                                                                                (Tezos_raw_protocol_alpha.Alpha_context.Delegate.Credited
                                                                                  reward))
                                                                              []))))))))))))))))))))))
  |
    Tezos_raw_protocol_alpha.Alpha_context.Single
      (Tezos_raw_protocol_alpha.Alpha_context.Activate_account {|
        Tezos_raw_protocol_alpha.Alpha_context.contents.Activate_account.id := pkh;
          Tezos_raw_protocol_alpha.Alpha_context.contents.Activate_account.activation_code
            := activation_code
          |}) =>
    let blinded_pkh :=
      Blinded_public_key_hash.of_ed25519_pkh activation_code pkh in
    op_gtgteqquestion (Commitment.get_opt ctxt blinded_pkh)
      (fun function_parameter =>
        match function_parameter with
        | None =>
          fail
            (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_activation
              {| Invalid_activation.pkh := pkh |})
        | Some amount =>
          op_gtgteqquestion (Commitment.delete ctxt blinded_pkh)
            (fun ctxt =>
              let contract :=
                Contract.implicit_contract
                  (Tezos_protocol_environment_alpha__Environment.Signature.Ed25519
                    pkh) in
              op_gtgteqquestion (credit ctxt contract amount)
                (fun ctxt =>
                  __return
                    (ctxt,
                      (Tezos_raw_protocol_alpha.Apply_results.Single_result
                        (Tezos_raw_protocol_alpha.Apply_results.Activate_account_result
                          (cons
                            ((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Contract
                              contract),
                              (Tezos_raw_protocol_alpha.Alpha_context.Delegate.Credited
                                amount)) []))))))
        end)
  |
    Tezos_raw_protocol_alpha.Alpha_context.Single
      (Tezos_raw_protocol_alpha.Alpha_context.Proposals {|
        Tezos_raw_protocol_alpha.Alpha_context.contents.Proposals.source := source;
          Tezos_raw_protocol_alpha.Alpha_context.contents.Proposals.period :=
            period;
          Tezos_raw_protocol_alpha.Alpha_context.contents.Proposals.proposals :=
            proposals
          |}) =>
    op_gtgteqquestion (Roll.delegate_pubkey ctxt source)
      (fun delegate =>
        op_gtgteqquestion
          (Operation.check_signature delegate chain_id operation)
          (fun function_parameter =>
            let 'tt := function_parameter in
            let level := Level.current ctxt in
            op_gtgteqquestion
              (fail_unless
                (op_eq
                  (Tezos_raw_protocol_alpha.Alpha_context.Level.t.voting_period
                    level) period)
                (Tezos_protocol_environment_alpha__Environment.Error_monad.Wrong_voting_period
                  (Tezos_raw_protocol_alpha.Alpha_context.Level.t.voting_period
                    level) period))
              (fun function_parameter =>
                let 'tt := function_parameter in
                op_gtgteqquestion
                  (Amendment.record_proposals ctxt source proposals)
                  (fun ctxt =>
                    __return
                      (ctxt,
                        (Tezos_raw_protocol_alpha.Apply_results.Single_result
                          Tezos_raw_protocol_alpha.Apply_results.Proposals_result))))))
  |
    Tezos_raw_protocol_alpha.Alpha_context.Single
      (Tezos_raw_protocol_alpha.Alpha_context.Ballot {|
        Tezos_raw_protocol_alpha.Alpha_context.contents.Ballot.source := source;
          Tezos_raw_protocol_alpha.Alpha_context.contents.Ballot.period :=
            period;
          Tezos_raw_protocol_alpha.Alpha_context.contents.Ballot.proposal :=
            proposal;
          Tezos_raw_protocol_alpha.Alpha_context.contents.Ballot.ballot :=
            ballot
          |}) =>
    op_gtgteqquestion (Roll.delegate_pubkey ctxt source)
      (fun delegate =>
        op_gtgteqquestion
          (Operation.check_signature delegate chain_id operation)
          (fun function_parameter =>
            let 'tt := function_parameter in
            let level := Level.current ctxt in
            op_gtgteqquestion
              (fail_unless
                (op_eq
                  (Tezos_raw_protocol_alpha.Alpha_context.Level.t.voting_period
                    level) period)
                (Tezos_protocol_environment_alpha__Environment.Error_monad.Wrong_voting_period
                  (Tezos_raw_protocol_alpha.Alpha_context.Level.t.voting_period
                    level) period))
              (fun function_parameter =>
                let 'tt := function_parameter in
                op_gtgteqquestion
                  (Amendment.record_ballot ctxt source proposal ballot)
                  (fun ctxt =>
                    __return
                      (ctxt,
                        (Tezos_raw_protocol_alpha.Apply_results.Single_result
                          Tezos_raw_protocol_alpha.Apply_results.Ballot_result))))))
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Single
      (Tezos_raw_protocol_alpha.Alpha_context.Manager_operation _)) as op =>
    op_gtgteqquestion
      (precheck_manager_contents_list ctxt chain_id operation op)
      (fun ctxt =>
        op_gtgteq (apply_manager_contents_list ctxt mode baker chain_id op)
          (fun function_parameter =>
            let '(ctxt, __result_value) := function_parameter in
            __return (ctxt, __result_value)))
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Cons
      (Tezos_raw_protocol_alpha.Alpha_context.Manager_operation _) _) as op =>
    op_gtgteqquestion
      (precheck_manager_contents_list ctxt chain_id operation op)
      (fun ctxt =>
        op_gtgteq (apply_manager_contents_list ctxt mode baker chain_id op)
          (fun function_parameter =>
            let '(ctxt, __result_value) := function_parameter in
            __return (ctxt, __result_value)))
  end.

Definition apply_operation {A : Set}
  (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
  (chain_id : Tezos_protocol_environment_alpha__Environment.Chain_id.t)
  (mode : Tezos_raw_protocol_alpha.Script_ir_translator.unparsing_mode)
  (pred_block : Tezos_protocol_environment_alpha__Environment.Block_hash.t)
  (baker :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  (__hash_value : Tezos_protocol_environment_alpha__Environment.Operation_hash.t)
  (operation : Tezos_raw_protocol_alpha.Alpha_context.operation A)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha__Alpha_context.context *
        Tezos_raw_protocol_alpha.Apply_results.operation_metadata A)) :=
  let ctxt := Contract.init_origination_nonce ctxt __hash_value in
  op_gtgteqquestion
    (apply_contents_list ctxt chain_id mode pred_block baker operation
      (Tezos_raw_protocol_alpha.Alpha_context.protocol_data.contents
        (Tezos_raw_protocol_alpha.Alpha_context.operation.protocol_data
          operation)))
    (fun function_parameter =>
      let '(ctxt, __result_value) := function_parameter in
      let ctxt := Gas.set_unlimited ctxt in
      let ctxt := Contract.unset_origination_nonce ctxt in
      __return
        (ctxt,
          {|
            Tezos_raw_protocol_alpha.Apply_results.operation_metadata.contents :=
              __result_value |})).

Definition may_snapshot_roll
  (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha__Alpha_context.context) :=
  let level := Alpha_context.Level.current ctxt in
  let blocks_per_roll_snapshot := Constants.blocks_per_roll_snapshot ctxt in
  if
    Compare.Int32.equal
      (Int32.rem
        (Tezos_raw_protocol_alpha.Alpha_context.Level.t.cycle_position level)
        blocks_per_roll_snapshot) (Int32.pred blocks_per_roll_snapshot) then
    op_gtgteqquestion (Alpha_context.Roll.snapshot_rolls ctxt)
      (fun ctxt => __return ctxt)
  else
    __return ctxt.

Definition may_start_new_cycle
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Alpha_context.context *
        Tezos_raw_protocol_alpha.Alpha_context.Delegate.balance_updates *
        list
          Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)) :=
  op_gtgteqquestion (Baking.dawn_of_a_new_cycle ctxt)
    (fun function_parameter =>
      match function_parameter with
      | None => __return (ctxt, [], [])
      | Some last_cycle =>
        op_gtgteqquestion (Seed.cycle_end ctxt last_cycle)
          (fun function_parameter =>
            let '(ctxt, unrevealed) := function_parameter in
            op_gtgteqquestion (Roll.cycle_end ctxt last_cycle)
              (fun ctxt =>
                op_gtgteqquestion
                  (Delegate.cycle_end ctxt last_cycle unrevealed)
                  (fun function_parameter =>
                    let '(ctxt, update_balances, deactivated) :=
                      function_parameter in
                    op_gtgteqquestion (Bootstrap.cycle_end ctxt last_cycle)
                      (fun ctxt => __return (ctxt, update_balances, deactivated)))))
      end).

Definition begin_full_construction
  (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
  (pred_timestamp : Tezos_protocol_environment_alpha__Environment.Time.t)
  (protocol_data : Tezos_raw_protocol_alpha.Alpha_context.Block_header.contents)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Alpha_context.context *
        Tezos_raw_protocol_alpha.Alpha_context.Block_header.contents *
        Tezos_raw_protocol_alpha.Alpha_context.public_key *
        Tezos_raw_protocol_alpha.Alpha_context.Period.t)) :=
  op_gtgteqquestion
    (Alpha_context.Global.set_block_priority ctxt
      (Tezos_raw_protocol_alpha.Alpha_context.Block_header.contents.priority
        protocol_data))
    (fun ctxt =>
      op_gtgteqquestion
        (Baking.check_baking_rights ctxt protocol_data pred_timestamp)
        (fun function_parameter =>
          let '(delegate_pk, block_delay) := function_parameter in
          let ctxt := Fitness.increase None ctxt in
          match Level.pred ctxt (Level.current ctxt) with
          | None =>
            (* ❌ Assert instruction is not handled. *)
            assert false
          | Some pred_level =>
            op_gtgteqquestion (Baking.endorsement_rights ctxt pred_level)
              (fun rights =>
                let ctxt := init_endorsements ctxt rights in
                __return (ctxt, protocol_data, delegate_pk, block_delay))
          end)).

Definition begin_partial_construction
  (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Alpha_context.context) :=
  let ctxt := Fitness.increase None ctxt in
  match Level.pred ctxt (Level.current ctxt) with
  | None =>
    (* ❌ Assert instruction is not handled. *)
    assert false
  | Some pred_level =>
    op_gtgteqquestion (Baking.endorsement_rights ctxt pred_level)
      (fun rights =>
        let ctxt := init_endorsements ctxt rights in
        __return ctxt)
  end.

Definition begin_application
  (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
  (chain_id : Tezos_protocol_environment_alpha__Environment.Chain_id.t)
  (block_header : Tezos_raw_protocol_alpha.Alpha_context.Block_header.t)
  (pred_timestamp : Tezos_protocol_environment_alpha__Environment.Time.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Alpha_context.context *
        Tezos_raw_protocol_alpha.Alpha_context.public_key *
        Tezos_raw_protocol_alpha.Alpha_context.Period.t)) :=
  op_gtgteqquestion
    (Alpha_context.Global.set_block_priority ctxt
      (Tezos_raw_protocol_alpha.Alpha_context.Block_header.contents.priority
        (Tezos_raw_protocol_alpha.Alpha_context.Block_header.protocol_data.contents
          (Tezos_raw_protocol_alpha.Alpha_context.Block_header.t.protocol_data
            block_header))))
    (fun ctxt =>
      let current_level := Alpha_context.Level.current ctxt in
      op_gtgteqquestion (Baking.check_proof_of_work_stamp ctxt block_header)
        (fun function_parameter =>
          let 'tt := function_parameter in
          op_gtgteqquestion (Baking.check_fitness_gap ctxt block_header)
            (fun function_parameter =>
              let 'tt := function_parameter in
              op_gtgteqquestion
                (Baking.check_baking_rights ctxt
                  (Tezos_raw_protocol_alpha.Alpha_context.Block_header.protocol_data.contents
                    (Tezos_raw_protocol_alpha.Alpha_context.Block_header.t.protocol_data
                      block_header)) pred_timestamp)
                (fun function_parameter =>
                  let '(delegate_pk, block_delay) := function_parameter in
                  op_gtgteqquestion
                    (Baking.check_signature block_header chain_id delegate_pk)
                    (fun function_parameter =>
                      let 'tt := function_parameter in
                      let has_commitment :=
                        match
                          Tezos_raw_protocol_alpha.Alpha_context.Block_header.contents.seed_nonce_hash
                            (Tezos_raw_protocol_alpha.Alpha_context.Block_header.protocol_data.contents
                              (Tezos_raw_protocol_alpha.Alpha_context.Block_header.t.protocol_data
                                block_header)) with
                        | None => false
                        | Some _ => true
                        end in
                      op_gtgteqquestion
                        (fail_unless
                          (op_eq has_commitment
                            (Tezos_raw_protocol_alpha.Alpha_context.Level.t.expected_commitment
                              current_level))
                          (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_commitment
                            {|
                              Invalid_commitment.expected :=
                                Tezos_raw_protocol_alpha.Alpha_context.Level.t.expected_commitment
                                  current_level |}))
                        (fun function_parameter =>
                          let 'tt := function_parameter in
                          let ctxt := Fitness.increase None ctxt in
                          match Level.pred ctxt (Level.current ctxt) with
                          | None =>
                            (* ❌ Assert instruction is not handled. *)
                            assert false
                          | Some pred_level =>
                            op_gtgteqquestion
                              (Baking.endorsement_rights ctxt pred_level)
                              (fun rights =>
                                let ctxt := init_endorsements ctxt rights in
                                __return (ctxt, delegate_pk, block_delay))
                          end)))))).

Definition check_minimum_endorsements
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
  (protocol_data : Tezos_raw_protocol_alpha.Alpha_context.Block_header.contents)
  (block_delay : Tezos_raw_protocol_alpha.Alpha_context.Period.t)
  (included_endorsements :
    Tezos_protocol_environment_alpha__Environment.Compare.Int.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
  let minimum := Baking.minimum_allowed_endorsements ctxt block_delay in
  let timestamp := Timestamp.current ctxt in
  fail_unless (op_gteq included_endorsements minimum)
    (Tezos_protocol_environment_alpha__Environment.Error_monad.Not_enough_endorsements_for_priority
      {| Not_enough_endorsements_for_priority.required := minimum;
        Not_enough_endorsements_for_priority.priority :=
          Tezos_raw_protocol_alpha.Alpha_context.Block_header.contents.priority
            protocol_data;
        Not_enough_endorsements_for_priority.endorsements :=
          included_endorsements;
        Not_enough_endorsements_for_priority.timestamp := timestamp |}).

Definition finalize_application
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
  (protocol_data : Tezos_raw_protocol_alpha.Alpha_context.Block_header.contents)
  (delegate :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  (block_delay : Tezos_raw_protocol_alpha.Alpha_context.Period.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Alpha_context.context *
        Tezos_raw_protocol_alpha.Apply_results.block_metadata)) :=
  let included_endorsements := included_endorsements ctxt in
  op_gtgteqquestion
    (check_minimum_endorsements ctxt protocol_data block_delay
      included_endorsements)
    (fun function_parameter =>
      let 'tt := function_parameter in
      let deposit := Constants.block_security_deposit ctxt in
      op_gtgteqquestion (add_deposit ctxt delegate deposit)
        (fun ctxt =>
          op_gtgteqquestion
            (Baking.baking_reward ctxt
              (Tezos_raw_protocol_alpha.Alpha_context.Block_header.contents.priority
                protocol_data) included_endorsements)
            (fun reward =>
              op_gtgteqquestion (add_rewards ctxt reward)
                (fun ctxt =>
                  op_gtgteqquestion
                    (Signature.Public_key_hash.Map.fold
                      (fun delegate =>
                        fun deposit =>
                          fun ctxt =>
                            op_gtgteqquestion ctxt
                              (fun ctxt =>
                                Delegate.freeze_deposit ctxt delegate deposit))
                      (get_deposits ctxt) (__return ctxt))
                    (fun ctxt =>
                      let fees := Alpha_context.get_fees ctxt in
                      op_gtgteqquestion
                        (Delegate.freeze_fees ctxt delegate fees)
                        (fun ctxt =>
                          let rewards := Alpha_context.get_rewards ctxt in
                          op_gtgteqquestion
                            (Delegate.freeze_rewards ctxt delegate rewards)
                            (fun ctxt =>
                              op_gtgteqquestion
                                match
                                  Tezos_raw_protocol_alpha.Alpha_context.Block_header.contents.seed_nonce_hash
                                    protocol_data with
                                | None => __return ctxt
                                | Some nonce_hash =>
                                  Nonce.record_hash ctxt
                                    {|
                                      Tezos_raw_protocol_alpha.Alpha_context.Nonce.unrevealed.nonce_hash :=
                                        nonce_hash;
                                      Tezos_raw_protocol_alpha.Alpha_context.Nonce.unrevealed.delegate :=
                                        delegate;
                                      Tezos_raw_protocol_alpha.Alpha_context.Nonce.unrevealed.rewards :=
                                        rewards;
                                      Tezos_raw_protocol_alpha.Alpha_context.Nonce.unrevealed.fees :=
                                        fees |}
                                end
                                (fun ctxt =>
                                  op_gtgteqquestion (may_snapshot_roll ctxt)
                                    (fun ctxt =>
                                      op_gtgteqquestion
                                        (may_start_new_cycle ctxt)
                                        (fun function_parameter =>
                                          let
                                            '(ctxt, balance_updates, deactivated) :=
                                            function_parameter in
                                          op_gtgteqquestion
                                            (Amendment.may_start_new_voting_period
                                              ctxt)
                                            (fun ctxt =>
                                              let cycle :=
                                                Tezos_raw_protocol_alpha.Alpha_context.Level.t.cycle
                                                  (Level.current ctxt) in
                                              let balance_updates :=
                                                cleanup_balance_updates
                                                  (op_at
                                                    (cons
                                                      ((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Contract
                                                        (Contract.implicit_contract
                                                          delegate)),
                                                        (Tezos_raw_protocol_alpha.Alpha_context.Delegate.Debited
                                                          deposit))
                                                      (cons
                                                        ((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Deposits
                                                          delegate cycle),
                                                          (Tezos_raw_protocol_alpha.Alpha_context.Delegate.Credited
                                                            deposit))
                                                        (cons
                                                          ((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Rewards
                                                            delegate cycle),
                                                            (Tezos_raw_protocol_alpha.Alpha_context.Delegate.Credited
                                                              reward)) [])))
                                                    balance_updates) in
                                              let consumed_gas :=
                                                Z.sub
                                                  (Constants.hard_gas_limit_per_block
                                                    ctxt)
                                                  (Alpha_context.Gas.block_level
                                                    ctxt) in
                                              op_gtgteqquestion
                                                (Alpha_context.Vote.get_current_period_kind
                                                  ctxt)
                                                (fun voting_period_kind =>
                                                  let receipt :=
                                                    {|
                                                      Tezos_raw_protocol_alpha.Apply_results.block_metadata.baker :=
                                                        delegate;
                                                      Tezos_raw_protocol_alpha.Apply_results.block_metadata.level :=
                                                        Level.current ctxt;
                                                      Tezos_raw_protocol_alpha.Apply_results.block_metadata.voting_period_kind :=
                                                        voting_period_kind;
                                                      Tezos_raw_protocol_alpha.Apply_results.block_metadata.nonce_hash :=
                                                        Tezos_raw_protocol_alpha.Alpha_context.Block_header.contents.seed_nonce_hash
                                                          protocol_data;
                                                      Tezos_raw_protocol_alpha.Apply_results.block_metadata.consumed_gas :=
                                                        consumed_gas;
                                                      Tezos_raw_protocol_alpha.Apply_results.block_metadata.deactivated :=
                                                        deactivated;
                                                      Tezos_raw_protocol_alpha.Apply_results.block_metadata.balance_updates :=
                                                        balance_updates |} in
                                                  __return (ctxt, receipt))))))))))))).

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Alpha_context
open Data_encoding

let error_encoding =
  def
    "error"
    ~description:
      "The full list of RPC errors would be too long to include.\n\
       It is available at RPC `/errors` (GET).\n\
       Errors specific to protocol Alpha have an id that starts with \
       `proto.alpha`."
  @@ splitted
       ~json:
         (conv
            (fun err ->
              Data_encoding.Json.construct Error_monad.error_encoding err)
            (fun json ->
              Data_encoding.Json.destruct Error_monad.error_encoding json)
            json)
       ~binary:Error_monad.error_encoding

type _ successful_manager_operation_result =
  | Reveal_result : {
      consumed_gas : Z.t;
    }
      -> Kind.reveal successful_manager_operation_result
  | Transaction_result : {
      storage : Script.expr option;
      big_map_diff : Contract.big_map_diff option;
      balance_updates : Delegate.balance_updates;
      originated_contracts : Contract.t list;
      consumed_gas : Z.t;
      storage_size : Z.t;
      paid_storage_size_diff : Z.t;
      allocated_destination_contract : bool;
    }
      -> Kind.transaction successful_manager_operation_result
  | Origination_result : {
      big_map_diff : Contract.big_map_diff option;
      balance_updates : Delegate.balance_updates;
      originated_contracts : Contract.t list;
      consumed_gas : Z.t;
      storage_size : Z.t;
      paid_storage_size_diff : Z.t;
    }
      -> Kind.origination successful_manager_operation_result
  | Delegation_result : {
      consumed_gas : Z.t;
    }
      -> Kind.delegation successful_manager_operation_result

type packed_successful_manager_operation_result =
  | Successful_manager_result :
      'kind successful_manager_operation_result
      -> packed_successful_manager_operation_result

type 'kind manager_operation_result =
  | Applied of 'kind successful_manager_operation_result
  | Backtracked of
      'kind successful_manager_operation_result * error list option
  | Failed : 'kind Kind.manager * error list -> 'kind manager_operation_result
  | Skipped : 'kind Kind.manager -> 'kind manager_operation_result

type packed_internal_operation_result =
  | Internal_operation_result :
      'kind internal_operation * 'kind manager_operation_result
      -> packed_internal_operation_result

module Manager_result = struct
  type 'kind case =
    | MCase : {
        op_case : 'kind Operation.Encoding.Manager_operations.case;
        encoding : 'a Data_encoding.t;
        kind : 'kind Kind.manager;
        iselect :
          packed_internal_operation_result ->
          ('kind internal_operation * 'kind manager_operation_result) option;
        select :
          packed_successful_manager_operation_result ->
          'kind successful_manager_operation_result option;
        proj : 'kind successful_manager_operation_result -> 'a;
        inj : 'a -> 'kind successful_manager_operation_result;
        t : 'kind manager_operation_result Data_encoding.t;
      }
        -> 'kind case

  let make ~op_case ~encoding ~kind ~iselect ~select ~proj ~inj =
    let (Operation.Encoding.Manager_operations.MCase {name; _}) = op_case in
    let t =
      def (Format.asprintf "operation.alpha.operation_result.%s" name)
      @@ union
           ~tag_size:`Uint8
           [ case
               (Tag 0)
               ~title:"Applied"
               (merge_objs (obj1 (req "status" (constant "applied"))) encoding)
               (fun o ->
                 match o with
                 | Skipped _ | Failed _ | Backtracked _ ->
                     None
                 | Applied o -> (
                   match select (Successful_manager_result o) with
                   | None ->
                       None
                   | Some o ->
                       Some ((), proj o) ))
               (fun ((), x) -> Applied (inj x));
             case
               (Tag 1)
               ~title:"Failed"
               (obj2
                  (req "status" (constant "failed"))
                  (req "errors" (list error_encoding)))
               (function Failed (_, errs) -> Some ((), errs) | _ -> None)
               (fun ((), errs) -> Failed (kind, errs));
             case
               (Tag 2)
               ~title:"Skipped"
               (obj1 (req "status" (constant "skipped")))
               (function Skipped _ -> Some () | _ -> None)
               (fun () -> Skipped kind);
             case
               (Tag 3)
               ~title:"Backtracked"
               (merge_objs
                  (obj2
                     (req "status" (constant "backtracked"))
                     (opt "errors" (list error_encoding)))
                  encoding)
               (fun o ->
                 match o with
                 | Skipped _ | Failed _ | Applied _ ->
                     None
                 | Backtracked (o, errs) -> (
                   match select (Successful_manager_result o) with
                   | None ->
                       None
                   | Some o ->
                       Some (((), errs), proj o) ))
               (fun (((), errs), x) -> Backtracked (inj x, errs)) ]
    in
    MCase {op_case; encoding; kind; iselect; select; proj; inj; t}

  let reveal_case =
    make
      ~op_case:Operation.Encoding.Manager_operations.reveal_case
      ~encoding:Data_encoding.(obj1 (dft "consumed_gas" z Z.zero))
      ~iselect:(function
        | Internal_operation_result (({operation = Reveal _; _} as op), res) ->
            Some (op, res)
        | _ ->
            None)
      ~select:(function
        | Successful_manager_result (Reveal_result _ as op) ->
            Some op
        | _ ->
            None)
      ~kind:Kind.Reveal_manager_kind
      ~proj:(function Reveal_result {consumed_gas} -> consumed_gas)
      ~inj:(fun consumed_gas -> Reveal_result {consumed_gas})

  let transaction_case =
    make
      ~op_case:Operation.Encoding.Manager_operations.transaction_case
      ~encoding:
        (obj8
           (opt "storage" Script.expr_encoding)
           (opt "big_map_diff" Contract.big_map_diff_encoding)
           (dft "balance_updates" Delegate.balance_updates_encoding [])
           (dft "originated_contracts" (list Contract.encoding) [])
           (dft "consumed_gas" z Z.zero)
           (dft "storage_size" z Z.zero)
           (dft "paid_storage_size_diff" z Z.zero)
           (dft "allocated_destination_contract" bool false))
      ~iselect:(function
        | Internal_operation_result
            (({operation = Transaction _; _} as op), res) ->
            Some (op, res)
        | _ ->
            None)
      ~select:(function
        | Successful_manager_result (Transaction_result _ as op) ->
            Some op
        | _ ->
            None)
      ~kind:Kind.Transaction_manager_kind
      ~proj:(function
        | Transaction_result
            { storage;
              big_map_diff;
              balance_updates;
              originated_contracts;
              consumed_gas;
              storage_size;
              paid_storage_size_diff;
              allocated_destination_contract } ->
            ( storage,
              big_map_diff,
              balance_updates,
              originated_contracts,
              consumed_gas,
              storage_size,
              paid_storage_size_diff,
              allocated_destination_contract ))
      ~inj:
        (fun ( storage,
               big_map_diff,
               balance_updates,
               originated_contracts,
               consumed_gas,
               storage_size,
               paid_storage_size_diff,
               allocated_destination_contract ) ->
        Transaction_result
          {
            storage;
            big_map_diff;
            balance_updates;
            originated_contracts;
            consumed_gas;
            storage_size;
            paid_storage_size_diff;
            allocated_destination_contract;
          })

  let origination_case =
    make
      ~op_case:Operation.Encoding.Manager_operations.origination_case
      ~encoding:
        (obj6
           (opt "big_map_diff" Contract.big_map_diff_encoding)
           (dft "balance_updates" Delegate.balance_updates_encoding [])
           (dft "originated_contracts" (list Contract.encoding) [])
           (dft "consumed_gas" z Z.zero)
           (dft "storage_size" z Z.zero)
           (dft "paid_storage_size_diff" z Z.zero))
      ~iselect:(function
        | Internal_operation_result
            (({operation = Origination _; _} as op), res) ->
            Some (op, res)
        | _ ->
            None)
      ~select:(function
        | Successful_manager_result (Origination_result _ as op) ->
            Some op
        | _ ->
            None)
      ~proj:(function
        | Origination_result
            { big_map_diff;
              balance_updates;
              originated_contracts;
              consumed_gas;
              storage_size;
              paid_storage_size_diff } ->
            ( big_map_diff,
              balance_updates,
              originated_contracts,
              consumed_gas,
              storage_size,
              paid_storage_size_diff ))
      ~kind:Kind.Origination_manager_kind
      ~inj:
        (fun ( big_map_diff,
               balance_updates,
               originated_contracts,
               consumed_gas,
               storage_size,
               paid_storage_size_diff ) ->
        Origination_result
          {
            big_map_diff;
            balance_updates;
            originated_contracts;
            consumed_gas;
            storage_size;
            paid_storage_size_diff;
          })

  let delegation_case =
    make
      ~op_case:Operation.Encoding.Manager_operations.delegation_case
      ~encoding:Data_encoding.(obj1 (dft "consumed_gas" z Z.zero))
      ~iselect:(function
        | Internal_operation_result (({operation = Delegation _; _} as op), res)
          ->
            Some (op, res)
        | _ ->
            None)
      ~select:(function
        | Successful_manager_result (Delegation_result _ as op) ->
            Some op
        | _ ->
            None)
      ~kind:Kind.Delegation_manager_kind
      ~proj:(function Delegation_result {consumed_gas} -> consumed_gas)
      ~inj:(fun consumed_gas -> Delegation_result {consumed_gas})
end

let internal_operation_result_encoding :
    packed_internal_operation_result Data_encoding.t =
  let make (type kind)
      (Manager_result.MCase res_case : kind Manager_result.case) =
    let (Operation.Encoding.Manager_operations.MCase op_case) =
      res_case.op_case
    in
    case
      (Tag op_case.tag)
      ~title:op_case.name
      (merge_objs
         (obj3
            (req "kind" (constant op_case.name))
            (req "source" Contract.encoding)
            (req "nonce" uint16))
         (merge_objs op_case.encoding (obj1 (req "result" res_case.t))))
      (fun op ->
        match res_case.iselect op with
        | Some (op, res) ->
            Some (((), op.source, op.nonce), (op_case.proj op.operation, res))
        | None ->
            None)
      (fun (((), source, nonce), (op, res)) ->
        let op = {source; operation = op_case.inj op; nonce} in
        Internal_operation_result (op, res))
  in
  def "operation.alpha.internal_operation_result"
  @@ union
       [ make Manager_result.reveal_case;
         make Manager_result.transaction_case;
         make Manager_result.origination_case;
         make Manager_result.delegation_case ]

type 'kind contents_result =
  | Endorsement_result : {
      balance_updates : Delegate.balance_updates;
      delegate : Signature.Public_key_hash.t;
      slots : int list;
    }
      -> Kind.endorsement contents_result
  | Seed_nonce_revelation_result :
      Delegate.balance_updates
      -> Kind.seed_nonce_revelation contents_result
  | Double_endorsement_evidence_result :
      Delegate.balance_updates
      -> Kind.double_endorsement_evidence contents_result
  | Double_baking_evidence_result :
      Delegate.balance_updates
      -> Kind.double_baking_evidence contents_result
  | Activate_account_result :
      Delegate.balance_updates
      -> Kind.activate_account contents_result
  | Proposals_result : Kind.proposals contents_result
  | Ballot_result : Kind.ballot contents_result
  | Manager_operation_result : {
      balance_updates : Delegate.balance_updates;
      operation_result : 'kind manager_operation_result;
      internal_operation_results : packed_internal_operation_result list;
    }
      -> 'kind Kind.manager contents_result

type packed_contents_result =
  | Contents_result : 'kind contents_result -> packed_contents_result

type packed_contents_and_result =
  | Contents_and_result :
      'kind Operation.contents * 'kind contents_result
      -> packed_contents_and_result

type ('a, 'b) eq = Eq : ('a, 'a) eq

let equal_manager_kind :
    type a b. a Kind.manager -> b Kind.manager -> (a, b) eq option =
 fun ka kb ->
  match (ka, kb) with
  | (Kind.Reveal_manager_kind, Kind.Reveal_manager_kind) ->
      Some Eq
  | (Kind.Reveal_manager_kind, _) ->
      None
  | (Kind.Transaction_manager_kind, Kind.Transaction_manager_kind) ->
      Some Eq
  | (Kind.Transaction_manager_kind, _) ->
      None
  | (Kind.Origination_manager_kind, Kind.Origination_manager_kind) ->
      Some Eq
  | (Kind.Origination_manager_kind, _) ->
      None
  | (Kind.Delegation_manager_kind, Kind.Delegation_manager_kind) ->
      Some Eq
  | (Kind.Delegation_manager_kind, _) ->
      None

module Encoding = struct
  type 'kind case =
    | Case : {
        op_case : 'kind Operation.Encoding.case;
        encoding : 'a Data_encoding.t;
        select : packed_contents_result -> 'kind contents_result option;
        mselect :
          packed_contents_and_result ->
          ('kind contents * 'kind contents_result) option;
        proj : 'kind contents_result -> 'a;
        inj : 'a -> 'kind contents_result;
      }
        -> 'kind case

  let tagged_case tag name args proj inj =
    let open Data_encoding in
    case
      tag
      ~title:(String.capitalize_ascii name)
      (merge_objs (obj1 (req "kind" (constant name))) args)
      (fun x -> match proj x with None -> None | Some x -> Some ((), x))
      (fun ((), x) -> inj x)

  let endorsement_case =
    Case
      {
        op_case = Operation.Encoding.endorsement_case;
        encoding =
          obj3
            (req "balance_updates" Delegate.balance_updates_encoding)
            (req "delegate" Signature.Public_key_hash.encoding)
            (req "slots" (list uint8));
        select =
          (function
          | Contents_result (Endorsement_result _ as op) -> Some op | _ -> None);
        mselect =
          (function
          | Contents_and_result ((Endorsement _ as op), res) ->
              Some (op, res)
          | _ ->
              None);
        proj =
          (function
          | Endorsement_result {balance_updates; delegate; slots} ->
              (balance_updates, delegate, slots));
        inj =
          (fun (balance_updates, delegate, slots) ->
            Endorsement_result {balance_updates; delegate; slots});
      }

  let seed_nonce_revelation_case =
    Case
      {
        op_case = Operation.Encoding.seed_nonce_revelation_case;
        encoding =
          obj1 (req "balance_updates" Delegate.balance_updates_encoding);
        select =
          (function
          | Contents_result (Seed_nonce_revelation_result _ as op) ->
              Some op
          | _ ->
              None);
        mselect =
          (function
          | Contents_and_result ((Seed_nonce_revelation _ as op), res) ->
              Some (op, res)
          | _ ->
              None);
        proj = (fun (Seed_nonce_revelation_result bus) -> bus);
        inj = (fun bus -> Seed_nonce_revelation_result bus);
      }

  let double_endorsement_evidence_case =
    Case
      {
        op_case = Operation.Encoding.double_endorsement_evidence_case;
        encoding =
          obj1 (req "balance_updates" Delegate.balance_updates_encoding);
        select =
          (function
          | Contents_result (Double_endorsement_evidence_result _ as op) ->
              Some op
          | _ ->
              None);
        mselect =
          (function
          | Contents_and_result ((Double_endorsement_evidence _ as op), res) ->
              Some (op, res)
          | _ ->
              None);
        proj = (fun (Double_endorsement_evidence_result bus) -> bus);
        inj = (fun bus -> Double_endorsement_evidence_result bus);
      }

  let double_baking_evidence_case =
    Case
      {
        op_case = Operation.Encoding.double_baking_evidence_case;
        encoding =
          obj1 (req "balance_updates" Delegate.balance_updates_encoding);
        select =
          (function
          | Contents_result (Double_baking_evidence_result _ as op) ->
              Some op
          | _ ->
              None);
        mselect =
          (function
          | Contents_and_result ((Double_baking_evidence _ as op), res) ->
              Some (op, res)
          | _ ->
              None);
        proj = (fun (Double_baking_evidence_result bus) -> bus);
        inj = (fun bus -> Double_baking_evidence_result bus);
      }

  let activate_account_case =
    Case
      {
        op_case = Operation.Encoding.activate_account_case;
        encoding =
          obj1 (req "balance_updates" Delegate.balance_updates_encoding);
        select =
          (function
          | Contents_result (Activate_account_result _ as op) ->
              Some op
          | _ ->
              None);
        mselect =
          (function
          | Contents_and_result ((Activate_account _ as op), res) ->
              Some (op, res)
          | _ ->
              None);
        proj = (fun (Activate_account_result bus) -> bus);
        inj = (fun bus -> Activate_account_result bus);
      }

  let proposals_case =
    Case
      {
        op_case = Operation.Encoding.proposals_case;
        encoding = Data_encoding.empty;
        select =
          (function
          | Contents_result (Proposals_result as op) -> Some op | _ -> None);
        mselect =
          (function
          | Contents_and_result ((Proposals _ as op), res) ->
              Some (op, res)
          | _ ->
              None);
        proj = (fun Proposals_result -> ());
        inj = (fun () -> Proposals_result);
      }

  let ballot_case =
    Case
      {
        op_case = Operation.Encoding.ballot_case;
        encoding = Data_encoding.empty;
        select =
          (function
          | Contents_result (Ballot_result as op) -> Some op | _ -> None);
        mselect =
          (function
          | Contents_and_result ((Ballot _ as op), res) ->
              Some (op, res)
          | _ ->
              None);
        proj = (fun Ballot_result -> ());
        inj = (fun () -> Ballot_result);
      }

  let make_manager_case (type kind)
      (Operation.Encoding.Case op_case :
        kind Kind.manager Operation.Encoding.case)
      (Manager_result.MCase res_case : kind Manager_result.case) mselect =
    Case
      {
        op_case = Operation.Encoding.Case op_case;
        encoding =
          obj3
            (req "balance_updates" Delegate.balance_updates_encoding)
            (req "operation_result" res_case.t)
            (dft
               "internal_operation_results"
               (list internal_operation_result_encoding)
               []);
        select =
          (function
          | Contents_result
              (Manager_operation_result
                ({operation_result = Applied res; _} as op)) -> (
            match res_case.select (Successful_manager_result res) with
            | Some res ->
                Some
                  (Manager_operation_result
                     {op with operation_result = Applied res})
            | None ->
                None )
          | Contents_result
              (Manager_operation_result
                ({operation_result = Backtracked (res, errs); _} as op)) -> (
            match res_case.select (Successful_manager_result res) with
            | Some res ->
                Some
                  (Manager_operation_result
                     {op with operation_result = Backtracked (res, errs)})
            | None ->
                None )
          | Contents_result
              (Manager_operation_result
                ({operation_result = Skipped kind; _} as op)) -> (
            match equal_manager_kind kind res_case.kind with
            | None ->
                None
            | Some Eq ->
                Some
                  (Manager_operation_result
                     {op with operation_result = Skipped kind}) )
          | Contents_result
              (Manager_operation_result
                ({operation_result = Failed (kind, errs); _} as op)) -> (
            match equal_manager_kind kind res_case.kind with
            | None ->
                None
            | Some Eq ->
                Some
                  (Manager_operation_result
                     {op with operation_result = Failed (kind, errs)}) )
          | Contents_result Ballot_result ->
              None
          | Contents_result (Endorsement_result _) ->
              None
          | Contents_result (Seed_nonce_revelation_result _) ->
              None
          | Contents_result (Double_endorsement_evidence_result _) ->
              None
          | Contents_result (Double_baking_evidence_result _) ->
              None
          | Contents_result (Activate_account_result _) ->
              None
          | Contents_result Proposals_result ->
              None);
        mselect;
        proj =
          (fun (Manager_operation_result
                 { balance_updates = bus;
                   operation_result = r;
                   internal_operation_results = rs }) ->
            (bus, r, rs));
        inj =
          (fun (bus, r, rs) ->
            Manager_operation_result
              {
                balance_updates = bus;
                operation_result = r;
                internal_operation_results = rs;
              });
      }

  let reveal_case =
    make_manager_case
      Operation.Encoding.reveal_case
      Manager_result.reveal_case
      (function
        | Contents_and_result
            ((Manager_operation {operation = Reveal _; _} as op), res) ->
            Some (op, res)
        | _ ->
            None)

  let transaction_case =
    make_manager_case
      Operation.Encoding.transaction_case
      Manager_result.transaction_case
      (function
        | Contents_and_result
            ((Manager_operation {operation = Transaction _; _} as op), res) ->
            Some (op, res)
        | _ ->
            None)

  let origination_case =
    make_manager_case
      Operation.Encoding.origination_case
      Manager_result.origination_case
      (function
        | Contents_and_result
            ((Manager_operation {operation = Origination _; _} as op), res) ->
            Some (op, res)
        | _ ->
            None)

  let delegation_case =
    make_manager_case
      Operation.Encoding.delegation_case
      Manager_result.delegation_case
      (function
        | Contents_and_result
            ((Manager_operation {operation = Delegation _; _} as op), res) ->
            Some (op, res)
        | _ ->
            None)
end

let contents_result_encoding =
  let open Encoding in
  let make
      (Case
        { op_case = Operation.Encoding.Case {tag; name; _};
          encoding;
          mselect = _;
          select;
          proj;
          inj }) =
    let proj x =
      match select x with None -> None | Some x -> Some (proj x)
    in
    let inj x = Contents_result (inj x) in
    tagged_case (Tag tag) name encoding proj inj
  in
  def "operation.alpha.contents_result"
  @@ union
       [ make endorsement_case;
         make seed_nonce_revelation_case;
         make double_endorsement_evidence_case;
         make double_baking_evidence_case;
         make activate_account_case;
         make proposals_case;
         make ballot_case;
         make reveal_case;
         make transaction_case;
         make origination_case;
         make delegation_case ]

let contents_and_result_encoding =
  let open Encoding in
  let make
      (Case
        { op_case = Operation.Encoding.Case {tag; name; encoding; proj; inj; _};
          mselect;
          encoding = meta_encoding;
          proj = meta_proj;
          inj = meta_inj;
          _ }) =
    let proj c =
      match mselect c with
      | Some (op, res) ->
          Some (proj op, meta_proj res)
      | _ ->
          None
    in
    let inj (op, res) = Contents_and_result (inj op, meta_inj res) in
    let encoding = merge_objs encoding (obj1 (req "metadata" meta_encoding)) in
    tagged_case (Tag tag) name encoding proj inj
  in
  def "operation.alpha.operation_contents_and_result"
  @@ union
       [ make endorsement_case;
         make seed_nonce_revelation_case;
         make double_endorsement_evidence_case;
         make double_baking_evidence_case;
         make activate_account_case;
         make proposals_case;
         make ballot_case;
         make reveal_case;
         make transaction_case;
         make origination_case;
         make delegation_case ]

type 'kind contents_result_list =
  | Single_result : 'kind contents_result -> 'kind contents_result_list
  | Cons_result :
      'kind Kind.manager contents_result
      * 'rest Kind.manager contents_result_list
      -> ('kind * 'rest) Kind.manager contents_result_list

type packed_contents_result_list =
  | Contents_result_list :
      'kind contents_result_list
      -> packed_contents_result_list

let contents_result_list_encoding =
  let rec to_list = function
    | Contents_result_list (Single_result o) ->
        [Contents_result o]
    | Contents_result_list (Cons_result (o, os)) ->
        Contents_result o :: to_list (Contents_result_list os)
  in
  let rec of_list = function
    | [] ->
        Pervasives.failwith "cannot decode empty operation result"
    | [Contents_result o] ->
        Contents_result_list (Single_result o)
    | Contents_result o :: os -> (
        let (Contents_result_list os) = of_list os in
        match (o, os) with
        | ( Manager_operation_result _,
            Single_result (Manager_operation_result _) ) ->
            Contents_result_list (Cons_result (o, os))
        | (Manager_operation_result _, Cons_result _) ->
            Contents_result_list (Cons_result (o, os))
        | _ ->
            Pervasives.failwith "cannot decode ill-formed operation result" )
  in
  def "operation.alpha.contents_list_result"
  @@ conv to_list of_list (list contents_result_encoding)

type 'kind contents_and_result_list =
  | Single_and_result :
      'kind Alpha_context.contents * 'kind contents_result
      -> 'kind contents_and_result_list
  | Cons_and_result :
      'kind Kind.manager Alpha_context.contents
      * 'kind Kind.manager contents_result
      * 'rest Kind.manager contents_and_result_list
      -> ('kind * 'rest) Kind.manager contents_and_result_list

type packed_contents_and_result_list =
  | Contents_and_result_list :
      'kind contents_and_result_list
      -> packed_contents_and_result_list

let contents_and_result_list_encoding =
  let rec to_list = function
    | Contents_and_result_list (Single_and_result (op, res)) ->
        [Contents_and_result (op, res)]
    | Contents_and_result_list (Cons_and_result (op, res, rest)) ->
        Contents_and_result (op, res)
        :: to_list (Contents_and_result_list rest)
  in
  let rec of_list = function
    | [] ->
        Pervasives.failwith "cannot decode empty combined operation result"
    | [Contents_and_result (op, res)] ->
        Contents_and_result_list (Single_and_result (op, res))
    | Contents_and_result (op, res) :: rest -> (
        let (Contents_and_result_list rest) = of_list rest in
        match (op, rest) with
        | (Manager_operation _, Single_and_result (Manager_operation _, _)) ->
            Contents_and_result_list (Cons_and_result (op, res, rest))
        | (Manager_operation _, Cons_and_result (_, _, _)) ->
            Contents_and_result_list (Cons_and_result (op, res, rest))
        | _ ->
            Pervasives.failwith
              "cannot decode ill-formed combined operation result" )
  in
  conv to_list of_list (Variable.list contents_and_result_encoding)

type 'kind operation_metadata = {contents : 'kind contents_result_list}

type packed_operation_metadata =
  | Operation_metadata : 'kind operation_metadata -> packed_operation_metadata
  | No_operation_metadata : packed_operation_metadata

let operation_metadata_encoding =
  def "operation.alpha.result"
  @@ union
       [ case
           (Tag 0)
           ~title:"Operation_metadata"
           contents_result_list_encoding
           (function
             | Operation_metadata {contents} ->
                 Some (Contents_result_list contents)
             | _ ->
                 None)
           (fun (Contents_result_list contents) ->
             Operation_metadata {contents});
         case
           (Tag 1)
           ~title:"No_operation_metadata"
           empty
           (function No_operation_metadata -> Some () | _ -> None)
           (fun () -> No_operation_metadata) ]

let kind_equal :
    type kind kind2.
    kind contents -> kind2 contents_result -> (kind, kind2) eq option =
 fun op res ->
  match (op, res) with
  | (Endorsement _, Endorsement_result _) ->
      Some Eq
  | (Endorsement _, _) ->
      None
  | (Seed_nonce_revelation _, Seed_nonce_revelation_result _) ->
      Some Eq
  | (Seed_nonce_revelation _, _) ->
      None
  | (Double_endorsement_evidence _, Double_endorsement_evidence_result _) ->
      Some Eq
  | (Double_endorsement_evidence _, _) ->
      None
  | (Double_baking_evidence _, Double_baking_evidence_result _) ->
      Some Eq
  | (Double_baking_evidence _, _) ->
      None
  | (Activate_account _, Activate_account_result _) ->
      Some Eq
  | (Activate_account _, _) ->
      None
  | (Proposals _, Proposals_result) ->
      Some Eq
  | (Proposals _, _) ->
      None
  | (Ballot _, Ballot_result) ->
      Some Eq
  | (Ballot _, _) ->
      None
  | ( Manager_operation {operation = Reveal _; _},
      Manager_operation_result {operation_result = Applied (Reveal_result _); _}
    ) ->
      Some Eq
  | ( Manager_operation {operation = Reveal _; _},
      Manager_operation_result
        {operation_result = Backtracked (Reveal_result _, _); _} ) ->
      Some Eq
  | ( Manager_operation {operation = Reveal _; _},
      Manager_operation_result
        { operation_result = Failed (Alpha_context.Kind.Reveal_manager_kind, _);
          _ } ) ->
      Some Eq
  | ( Manager_operation {operation = Reveal _; _},
      Manager_operation_result
        {operation_result = Skipped Alpha_context.Kind.Reveal_manager_kind; _}
    ) ->
      Some Eq
  | (Manager_operation {operation = Reveal _; _}, _) ->
      None
  | ( Manager_operation {operation = Transaction _; _},
      Manager_operation_result
        {operation_result = Applied (Transaction_result _); _} ) ->
      Some Eq
  | ( Manager_operation {operation = Transaction _; _},
      Manager_operation_result
        {operation_result = Backtracked (Transaction_result _, _); _} ) ->
      Some Eq
  | ( Manager_operation {operation = Transaction _; _},
      Manager_operation_result
        { operation_result =
            Failed (Alpha_context.Kind.Transaction_manager_kind, _);
          _ } ) ->
      Some Eq
  | ( Manager_operation {operation = Transaction _; _},
      Manager_operation_result
        { operation_result = Skipped Alpha_context.Kind.Transaction_manager_kind;
          _ } ) ->
      Some Eq
  | (Manager_operation {operation = Transaction _; _}, _) ->
      None
  | ( Manager_operation {operation = Origination _; _},
      Manager_operation_result
        {operation_result = Applied (Origination_result _); _} ) ->
      Some Eq
  | ( Manager_operation {operation = Origination _; _},
      Manager_operation_result
        {operation_result = Backtracked (Origination_result _, _); _} ) ->
      Some Eq
  | ( Manager_operation {operation = Origination _; _},
      Manager_operation_result
        { operation_result =
            Failed (Alpha_context.Kind.Origination_manager_kind, _);
          _ } ) ->
      Some Eq
  | ( Manager_operation {operation = Origination _; _},
      Manager_operation_result
        { operation_result = Skipped Alpha_context.Kind.Origination_manager_kind;
          _ } ) ->
      Some Eq
  | (Manager_operation {operation = Origination _; _}, _) ->
      None
  | ( Manager_operation {operation = Delegation _; _},
      Manager_operation_result
        {operation_result = Applied (Delegation_result _); _} ) ->
      Some Eq
  | ( Manager_operation {operation = Delegation _; _},
      Manager_operation_result
        {operation_result = Backtracked (Delegation_result _, _); _} ) ->
      Some Eq
  | ( Manager_operation {operation = Delegation _; _},
      Manager_operation_result
        { operation_result =
            Failed (Alpha_context.Kind.Delegation_manager_kind, _);
          _ } ) ->
      Some Eq
  | ( Manager_operation {operation = Delegation _; _},
      Manager_operation_result
        { operation_result = Skipped Alpha_context.Kind.Delegation_manager_kind;
          _ } ) ->
      Some Eq
  | (Manager_operation {operation = Delegation _; _}, _) ->
      None

let rec kind_equal_list :
    type kind kind2.
    kind contents_list -> kind2 contents_result_list -> (kind, kind2) eq option
    =
 fun contents res ->
  match (contents, res) with
  | (Single op, Single_result res) -> (
    match kind_equal op res with None -> None | Some Eq -> Some Eq )
  | (Cons (op, ops), Cons_result (res, ress)) -> (
    match kind_equal op res with
    | None ->
        None
    | Some Eq -> (
      match kind_equal_list ops ress with None -> None | Some Eq -> Some Eq ) )
  | _ ->
      None

let rec pack_contents_list :
    type kind.
    kind contents_list ->
    kind contents_result_list ->
    kind contents_and_result_list =
 fun contents res ->
  match (contents, res) with
  | (Single op, Single_result res) ->
      Single_and_result (op, res)
  | (Cons (op, ops), Cons_result (res, ress)) ->
      Cons_and_result (op, res, pack_contents_list ops ress)
  | ( Single (Manager_operation _),
      Cons_result (Manager_operation_result _, Single_result _) ) ->
      .
  | ( Cons (_, _),
      Single_result (Manager_operation_result {operation_result = Failed _; _})
    ) ->
      .
  | ( Cons (_, _),
      Single_result
        (Manager_operation_result {operation_result = Skipped _; _}) ) ->
      .
  | ( Cons (_, _),
      Single_result
        (Manager_operation_result {operation_result = Applied _; _}) ) ->
      .
  | ( Cons (_, _),
      Single_result
        (Manager_operation_result {operation_result = Backtracked _; _}) ) ->
      .
  | (Single _, Cons_result _) ->
      .

let rec unpack_contents_list :
    type kind.
    kind contents_and_result_list ->
    kind contents_list * kind contents_result_list = function
  | Single_and_result (op, res) ->
      (Single op, Single_result res)
  | Cons_and_result (op, res, rest) ->
      let (ops, ress) = unpack_contents_list rest in
      (Cons (op, ops), Cons_result (res, ress))

let rec to_list = function
  | Contents_result_list (Single_result o) ->
      [Contents_result o]
  | Contents_result_list (Cons_result (o, os)) ->
      Contents_result o :: to_list (Contents_result_list os)

let rec of_list = function
  | [] ->
      assert false
  | [Contents_result o] ->
      Contents_result_list (Single_result o)
  | Contents_result o :: os -> (
      let (Contents_result_list os) = of_list os in
      match (o, os) with
      | (Manager_operation_result _, Single_result (Manager_operation_result _))
        ->
          Contents_result_list (Cons_result (o, os))
      | (Manager_operation_result _, Cons_result _) ->
          Contents_result_list (Cons_result (o, os))
      | _ ->
          Pervasives.failwith
            "Operation result list of length > 1 should only contains manager \
             operations result." )

let operation_data_and_metadata_encoding =
  def "operation.alpha.operation_with_metadata"
  @@ union
       [ case
           (Tag 0)
           ~title:"Operation_with_metadata"
           (obj2
              (req "contents" (dynamic_size contents_and_result_list_encoding))
              (opt "signature" Signature.encoding))
           (function
             | (Operation_data _, No_operation_metadata) ->
                 None
             | (Operation_data op, Operation_metadata res) -> (
               match kind_equal_list op.contents res.contents with
               | None ->
                   Pervasives.failwith
                     "cannot decode inconsistent combined operation result"
               | Some Eq ->
                   Some
                     ( Contents_and_result_list
                         (pack_contents_list op.contents res.contents),
                       op.signature ) ))
           (fun (Contents_and_result_list contents, signature) ->
             let (op_contents, res_contents) = unpack_contents_list contents in
             ( Operation_data {contents = op_contents; signature},
               Operation_metadata {contents = res_contents} ));
         case
           (Tag 1)
           ~title:"Operation_without_metadata"
           (obj2
              (req "contents" (dynamic_size Operation.contents_list_encoding))
              (opt "signature" Signature.encoding))
           (function
             | (Operation_data op, No_operation_metadata) ->
                 Some (Contents_list op.contents, op.signature)
             | (Operation_data _, Operation_metadata _) ->
                 None)
           (fun (Contents_list contents, signature) ->
             (Operation_data {contents; signature}, No_operation_metadata)) ]

type block_metadata = {
  baker : Signature.Public_key_hash.t;
  level : Level.t;
  voting_period_kind : Voting_period.kind;
  nonce_hash : Nonce_hash.t option;
  consumed_gas : Z.t;
  deactivated : Signature.Public_key_hash.t list;
  balance_updates : Delegate.balance_updates;
}

let block_metadata_encoding =
  let open Data_encoding in
  def "block_header.alpha.metadata"
  @@ conv
       (fun { baker;
              level;
              voting_period_kind;
              nonce_hash;
              consumed_gas;
              deactivated;
              balance_updates } ->
         ( baker,
           level,
           voting_period_kind,
           nonce_hash,
           consumed_gas,
           deactivated,
           balance_updates ))
       (fun ( baker,
              level,
              voting_period_kind,
              nonce_hash,
              consumed_gas,
              deactivated,
              balance_updates ) ->
         {
           baker;
           level;
           voting_period_kind;
           nonce_hash;
           consumed_gas;
           deactivated;
           balance_updates;
         })
       (obj7
          (req "baker" Signature.Public_key_hash.encoding)
          (req "level" Level.encoding)
          (req "voting_period_kind" Voting_period.kind_encoding)
          (req "nonce_hash" (option Nonce_hash.encoding))
          (req "consumed_gas" (check_size 10 n))
          (req "deactivated" (list Signature.Public_key_hash.encoding))
          (req "balance_updates" Delegate.balance_updates_encoding))

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Import Alpha_context.

Import Data_encoding.

Definition error_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    Tezos_protocol_environment_alpha__Environment.Error_monad.__error :=
  op_atat
    (let arg :=
      def "error" % string
        (* ❌ expected an argument *)
        expected_argument
        (Some
          "The full list of RPC errors would be too long to include.
It is available at RPC `/errors` (GET).
Errors specific to protocol Alpha have an id that starts with `proto.alpha`."
            % string) in
    fun eta => arg None eta)
    (splitted
      (conv
        (fun err => Data_encoding.Json.construct Error_monad.error_encoding err)
        (fun __json_value =>
          Data_encoding.Json.destruct Error_monad.error_encoding __json_value)
        None __json_value) Error_monad.error_encoding).

Reserved Notation "'successful_manager_operation_result".

Inductive successful_manager_operation_result_gadt : Set :=
| Reveal_result :
  Tezos_protocol_environment_alpha__Environment.Z.t ->
  successful_manager_operation_result_gadt
| Transaction_result :
  option Tezos_raw_protocol_alpha.Alpha_context.Script.expr ->
  option Tezos_raw_protocol_alpha.Alpha_context.Contract.big_map_diff ->
  Tezos_raw_protocol_alpha.Alpha_context.Delegate.balance_updates ->
  list Tezos_raw_protocol_alpha.Alpha_context.Contract.t ->
  Tezos_protocol_environment_alpha__Environment.Z.t ->
  Tezos_protocol_environment_alpha__Environment.Z.t ->
  Tezos_protocol_environment_alpha__Environment.Z.t -> bool ->
  successful_manager_operation_result_gadt
| Origination_result :
  option Tezos_raw_protocol_alpha.Alpha_context.Contract.big_map_diff ->
  Tezos_raw_protocol_alpha.Alpha_context.Delegate.balance_updates ->
  list Tezos_raw_protocol_alpha.Alpha_context.Contract.t ->
  Tezos_protocol_environment_alpha__Environment.Z.t ->
  Tezos_protocol_environment_alpha__Environment.Z.t ->
  Tezos_protocol_environment_alpha__Environment.Z.t ->
  successful_manager_operation_result_gadt
| Delegation_result :
  Tezos_protocol_environment_alpha__Environment.Z.t ->
  successful_manager_operation_result_gadt

where "'successful_manager_operation_result" := (fun (_ : Set) =>
  successful_manager_operation_result_gadt).

Definition successful_manager_operation_result :=
  'successful_manager_operation_result.

Reserved Notation "'packed_successful_manager_operation_result".

Inductive packed_successful_manager_operation_result_gadt : Set :=
| Successful_manager_result : forall {kind : Set},
  successful_manager_operation_result kind ->
  packed_successful_manager_operation_result_gadt

where "'packed_successful_manager_operation_result" :=
  (packed_successful_manager_operation_result_gadt).

Definition packed_successful_manager_operation_result :=
  'packed_successful_manager_operation_result.

Reserved Notation "'manager_operation_result".

Inductive manager_operation_result_gadt : Set :=
| Applied : forall {kind : Set},
  successful_manager_operation_result kind -> manager_operation_result_gadt
| Backtracked : forall {kind : Set},
  successful_manager_operation_result kind ->
  option
    (list Tezos_protocol_environment_alpha__Environment.Error_monad.__error) ->
  manager_operation_result_gadt
| Failed : forall {kind : Set},
  Tezos_raw_protocol_alpha.Alpha_context.Kind.manager kind ->
  list Tezos_protocol_environment_alpha__Environment.Error_monad.__error ->
  manager_operation_result_gadt
| Skipped : forall {kind : Set},
  Tezos_raw_protocol_alpha.Alpha_context.Kind.manager kind ->
  manager_operation_result_gadt

where "'manager_operation_result" := (fun (kind : Set) =>
  manager_operation_result_gadt).

Definition manager_operation_result := 'manager_operation_result.

Reserved Notation "'packed_internal_operation_result".

Inductive packed_internal_operation_result_gadt : Set :=
| Internal_operation_result : forall {kind : Set},
  Tezos_raw_protocol_alpha.Alpha_context.internal_operation kind ->
  manager_operation_result kind -> packed_internal_operation_result_gadt

where "'packed_internal_operation_result" :=
  (packed_internal_operation_result_gadt).

Definition packed_internal_operation_result :=
  'packed_internal_operation_result.

Module Manager_result.
  Reserved Notation "'case".
  
  Inductive case_gadt : Set :=
  | MCase : forall {a kind : Set},
    Tezos_raw_protocol_alpha.Alpha_context.Operation.Encoding.Manager_operations.case
      kind -> Tezos_protocol_environment_alpha__Environment.Data_encoding.t a ->
    Tezos_raw_protocol_alpha.Alpha_context.Kind.manager kind ->
    (packed_internal_operation_result ->
    option
      (Tezos_raw_protocol_alpha.Alpha_context.internal_operation kind *
        manager_operation_result kind)) ->
    (packed_successful_manager_operation_result ->
    option (successful_manager_operation_result kind)) ->
    (successful_manager_operation_result kind -> a) ->
    (a -> successful_manager_operation_result kind) ->
    Tezos_protocol_environment_alpha__Environment.Data_encoding.t
      (manager_operation_result kind) -> case_gadt
  
  where "'case" := (fun (kind : Set) => case_gadt).
  
  Definition case := 'case.
  
  Definition make {A B : Set}
    (op_case :
      Tezos_raw_protocol_alpha.Alpha_context.Operation.Encoding.Manager_operations.case
        A)
    (encoding :
      Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding B)
    (kind : Tezos_raw_protocol_alpha.Alpha_context.Kind.manager A)
    (iselect :
      packed_internal_operation_result ->
      option
        (Tezos_raw_protocol_alpha.Alpha_context.internal_operation A *
          manager_operation_result A))
    (select :
      packed_successful_manager_operation_result ->
      option (successful_manager_operation_result A))
    (proj : successful_manager_operation_result A -> B)
    (inj : B -> successful_manager_operation_result A) : case A :=
    let
      'Tezos_raw_protocol_alpha.Alpha_context.Operation.Encoding.Manager_operations.MCase
        {|
        Tezos_raw_protocol_alpha.Alpha_context.Operation.Encoding.Manager_operations.case.MCase.name
          := name
          |} := op_case in
    let t :=
      op_atat
        (let arg :=
          def
            (Format.asprintf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "operation.alpha.operation_result." % string
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String
                    Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
                    Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format))
                "operation.alpha.operation_result.%s" % string) name) in
        fun eta => arg None None eta)
        (union
          (Some
            (* ❌ Variants not supported *)
            variant)
          (cons
            (__case_value "Applied" % string None
              (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag 0)
              (merge_objs
                (obj1
                  (req None None "status" % string (constant "applied" % string)))
                encoding)
              (fun o =>
                match o with
                | Skipped _ | Failed _ _ | Backtracked _ _ => None
                | Applied o =>
                  match select (Successful_manager_result o) with
                  | None => None
                  | Some o => Some (tt, (proj o))
                  end
                end)
              (fun function_parameter =>
                let '(tt, x) := function_parameter in
                Applied (inj x)))
            (cons
              (__case_value "Failed" % string None
                (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag
                  1)
                (obj2
                  (req None None "status" % string (constant "failed" % string))
                  (req None None "errors" % string
                    (__list_value None error_encoding)))
                (fun function_parameter =>
                  match function_parameter with
                  | Failed _ errs => Some (tt, errs)
                  | _ => None
                  end)
                (fun function_parameter =>
                  let '(tt, errs) := function_parameter in
                  Failed kind errs))
              (cons
                (__case_value "Skipped" % string None
                  (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag
                    2)
                  (obj1
                    (req None None "status" % string
                      (constant "skipped" % string)))
                  (fun function_parameter =>
                    match function_parameter with
                    | Skipped _ => Some tt
                    | _ => None
                    end)
                  (fun function_parameter =>
                    let 'tt := function_parameter in
                    Skipped kind))
                (cons
                  (__case_value "Backtracked" % string None
                    (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag
                      3)
                    (merge_objs
                      (obj2
                        (req None None "status" % string
                          (constant "backtracked" % string))
                        (opt None None "errors" % string
                          (__list_value None error_encoding))) encoding)
                    (fun o =>
                      match o with
                      | Skipped _ | Failed _ _ | Applied _ => None
                      | Backtracked o errs =>
                        match select (Successful_manager_result o) with
                        | None => None
                        | Some o => Some ((tt, errs), (proj o))
                        end
                      end)
                    (fun function_parameter =>
                      let '((tt, errs), x) := function_parameter in
                      Backtracked (inj x) errs)) []))))) in
    MCase
      {| case.MCase.op_case := op_case; case.MCase.encoding := encoding;
        case.MCase.kind := kind; case.MCase.iselect := iselect;
        case.MCase.select := select; case.MCase.proj := proj;
        case.MCase.inj := inj; case.MCase.t := t |}.
  
  Definition reveal_case
    : case Tezos_raw_protocol_alpha.Alpha_context.Kind.reveal :=
    make Operation.Encoding.Manager_operations.reveal_case
      (obj1 (dft None None "consumed_gas" % string z Z.zero))
      Tezos_raw_protocol_alpha.Alpha_context.Kind.Reveal_manager_kind
      (fun function_parameter =>
        match function_parameter with
        |
          Internal_operation_result
            ({|
              Tezos_raw_protocol_alpha.Alpha_context.internal_operation.operation :=
                Tezos_raw_protocol_alpha.Alpha_context.Reveal _
                |} as op) res => Some (op, res)
        | _ => None
        end)
      (fun function_parameter =>
        match function_parameter with
        | Successful_manager_result ((Reveal_result _) as op) => Some op
        | _ => None
        end)
      (fun function_parameter =>
        let
          'Reveal_result {|
            successful_manager_operation_result.Reveal_result.consumed_gas := consumed_gas
              |} := function_parameter in
        consumed_gas)
      (fun consumed_gas =>
        Reveal_result
          {|
            successful_manager_operation_result.Reveal_result.consumed_gas :=
              consumed_gas |}).
  
  Definition transaction_case
    : case Tezos_raw_protocol_alpha.Alpha_context.Kind.transaction :=
    make Operation.Encoding.Manager_operations.transaction_case
      (obj8 (opt None None "storage" % string Script.expr_encoding)
        (opt None None "big_map_diff" % string Contract.big_map_diff_encoding)
        (dft None None "balance_updates" % string
          Delegate.balance_updates_encoding [])
        (dft None None "originated_contracts" % string
          (__list_value None Contract.encoding) [])
        (dft None None "consumed_gas" % string z Z.zero)
        (dft None None "storage_size" % string z Z.zero)
        (dft None None "paid_storage_size_diff" % string z Z.zero)
        (dft None None "allocated_destination_contract" % string __bool_value
          false))
      Tezos_raw_protocol_alpha.Alpha_context.Kind.Transaction_manager_kind
      (fun function_parameter =>
        match function_parameter with
        |
          Internal_operation_result
            ({|
              Tezos_raw_protocol_alpha.Alpha_context.internal_operation.operation :=
                Tezos_raw_protocol_alpha.Alpha_context.Transaction _
                |} as op) res => Some (op, res)
        | _ => None
        end)
      (fun function_parameter =>
        match function_parameter with
        | Successful_manager_result ((Transaction_result _) as op) => Some op
        | _ => None
        end)
      (fun function_parameter =>
        let
          'Transaction_result {|
            successful_manager_operation_result.Transaction_result.storage := storage;
              successful_manager_operation_result.Transaction_result.big_map_diff
                := big_map_diff;
              successful_manager_operation_result.Transaction_result.balance_updates
                := balance_updates;
              successful_manager_operation_result.Transaction_result.originated_contracts
                := originated_contracts;
              successful_manager_operation_result.Transaction_result.consumed_gas
                := consumed_gas;
              successful_manager_operation_result.Transaction_result.storage_size
                := storage_size;
              successful_manager_operation_result.Transaction_result.paid_storage_size_diff
                := paid_storage_size_diff;
              successful_manager_operation_result.Transaction_result.allocated_destination_contract
                := allocated_destination_contract
              |} := function_parameter in
        (storage, big_map_diff, balance_updates, originated_contracts,
          consumed_gas, storage_size, paid_storage_size_diff,
          allocated_destination_contract))
      (fun function_parameter =>
        let
          '(storage, big_map_diff, balance_updates, originated_contracts,
            consumed_gas, storage_size, paid_storage_size_diff,
            allocated_destination_contract) := function_parameter in
        Transaction_result
          {|
            successful_manager_operation_result.Transaction_result.storage :=
              storage;
            successful_manager_operation_result.Transaction_result.big_map_diff :=
              big_map_diff;
            successful_manager_operation_result.Transaction_result.balance_updates :=
              balance_updates;
            successful_manager_operation_result.Transaction_result.originated_contracts :=
              originated_contracts;
            successful_manager_operation_result.Transaction_result.consumed_gas :=
              consumed_gas;
            successful_manager_operation_result.Transaction_result.storage_size :=
              storage_size;
            successful_manager_operation_result.Transaction_result.paid_storage_size_diff :=
              paid_storage_size_diff;
            successful_manager_operation_result.Transaction_result.allocated_destination_contract :=
              allocated_destination_contract |}).
  
  Definition origination_case
    : case Tezos_raw_protocol_alpha.Alpha_context.Kind.origination :=
    make Operation.Encoding.Manager_operations.origination_case
      (obj6
        (opt None None "big_map_diff" % string Contract.big_map_diff_encoding)
        (dft None None "balance_updates" % string
          Delegate.balance_updates_encoding [])
        (dft None None "originated_contracts" % string
          (__list_value None Contract.encoding) [])
        (dft None None "consumed_gas" % string z Z.zero)
        (dft None None "storage_size" % string z Z.zero)
        (dft None None "paid_storage_size_diff" % string z Z.zero))
      Tezos_raw_protocol_alpha.Alpha_context.Kind.Origination_manager_kind
      (fun function_parameter =>
        match function_parameter with
        |
          Internal_operation_result
            ({|
              Tezos_raw_protocol_alpha.Alpha_context.internal_operation.operation :=
                Tezos_raw_protocol_alpha.Alpha_context.Origination _
                |} as op) res => Some (op, res)
        | _ => None
        end)
      (fun function_parameter =>
        match function_parameter with
        | Successful_manager_result ((Origination_result _) as op) => Some op
        | _ => None
        end)
      (fun function_parameter =>
        let
          'Origination_result {|
            successful_manager_operation_result.Origination_result.big_map_diff :=
              big_map_diff;
              successful_manager_operation_result.Origination_result.balance_updates
                := balance_updates;
              successful_manager_operation_result.Origination_result.originated_contracts
                := originated_contracts;
              successful_manager_operation_result.Origination_result.consumed_gas
                := consumed_gas;
              successful_manager_operation_result.Origination_result.storage_size
                := storage_size;
              successful_manager_operation_result.Origination_result.paid_storage_size_diff
                := paid_storage_size_diff
              |} := function_parameter in
        (big_map_diff, balance_updates, originated_contracts, consumed_gas,
          storage_size, paid_storage_size_diff))
      (fun function_parameter =>
        let
          '(big_map_diff, balance_updates, originated_contracts, consumed_gas,
            storage_size, paid_storage_size_diff) := function_parameter in
        Origination_result
          {|
            successful_manager_operation_result.Origination_result.big_map_diff :=
              big_map_diff;
            successful_manager_operation_result.Origination_result.balance_updates :=
              balance_updates;
            successful_manager_operation_result.Origination_result.originated_contracts :=
              originated_contracts;
            successful_manager_operation_result.Origination_result.consumed_gas :=
              consumed_gas;
            successful_manager_operation_result.Origination_result.storage_size :=
              storage_size;
            successful_manager_operation_result.Origination_result.paid_storage_size_diff :=
              paid_storage_size_diff |}).
  
  Definition delegation_case
    : case Tezos_raw_protocol_alpha.Alpha_context.Kind.delegation :=
    make Operation.Encoding.Manager_operations.delegation_case
      (obj1 (dft None None "consumed_gas" % string z Z.zero))
      Tezos_raw_protocol_alpha.Alpha_context.Kind.Delegation_manager_kind
      (fun function_parameter =>
        match function_parameter with
        |
          Internal_operation_result
            ({|
              Tezos_raw_protocol_alpha.Alpha_context.internal_operation.operation :=
                Tezos_raw_protocol_alpha.Alpha_context.Delegation _
                |} as op) res => Some (op, res)
        | _ => None
        end)
      (fun function_parameter =>
        match function_parameter with
        | Successful_manager_result ((Delegation_result _) as op) => Some op
        | _ => None
        end)
      (fun function_parameter =>
        let
          'Delegation_result {|
            successful_manager_operation_result.Delegation_result.consumed_gas :=
              consumed_gas
              |} := function_parameter in
        consumed_gas)
      (fun consumed_gas =>
        Delegation_result
          {|
            successful_manager_operation_result.Delegation_result.consumed_gas :=
              consumed_gas |}).
End Manager_result.

Definition internal_operation_result_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.t
    packed_internal_operation_result :=
  let make {A : Set} (function_parameter : Manager_result.case A)
    : Tezos_protocol_environment_alpha__Environment.Data_encoding.case
      packed_internal_operation_result :=
    let 'Manager_result.MCase res_case := function_parameter in
    let
      'Tezos_raw_protocol_alpha.Alpha_context.Operation.Encoding.Manager_operations.MCase
        op_case := Manager_result.case.MCase.op_case res_case in
    __case_value
      (Tezos_raw_protocol_alpha.Alpha_context.Operation.Encoding.Manager_operations.case.MCase.name
        op_case) None
      (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag
        (Tezos_raw_protocol_alpha.Alpha_context.Operation.Encoding.Manager_operations.case.MCase.tag
          op_case))
      (merge_objs
        (obj3
          (req None None "kind" % string
            (constant
              (Tezos_raw_protocol_alpha.Alpha_context.Operation.Encoding.Manager_operations.case.MCase.name
                op_case))) (req None None "source" % string Contract.encoding)
          (req None None "nonce" % string uint16))
        (merge_objs
          (Tezos_raw_protocol_alpha.Alpha_context.Operation.Encoding.Manager_operations.case.MCase.encoding
            op_case)
          (obj1
            (req None None "result" % string
              (Manager_result.case.MCase.t res_case)))))
      (fun op =>
        match (Manager_result.case.MCase.iselect res_case) op with
        | Some (op, res) =>
          Some
            ((tt,
              (Tezos_raw_protocol_alpha.Alpha_context.internal_operation.source
                op),
              (Tezos_raw_protocol_alpha.Alpha_context.internal_operation.nonce
                op)),
              (((Tezos_raw_protocol_alpha.Alpha_context.Operation.Encoding.Manager_operations.case.MCase.proj
                op_case)
                (Tezos_raw_protocol_alpha.Alpha_context.internal_operation.operation
                  op)), res))
        | None => None
        end)
      (fun function_parameter =>
        let '((tt, source, nonce), (op, res)) := function_parameter in
        let op :=
          {|
            Tezos_raw_protocol_alpha.Alpha_context.internal_operation.source :=
              source;
            Tezos_raw_protocol_alpha.Alpha_context.internal_operation.operation :=
              (Tezos_raw_protocol_alpha.Alpha_context.Operation.Encoding.Manager_operations.case.MCase.inj
                op_case) op;
            Tezos_raw_protocol_alpha.Alpha_context.internal_operation.nonce :=
              nonce |} in
        Internal_operation_result op res) in
  op_atat
    (let arg := def "operation.alpha.internal_operation_result" % string in
    fun eta => arg None None eta)
    (union None
      (cons (make Manager_result.reveal_case)
        (cons (make Manager_result.transaction_case)
          (cons (make Manager_result.origination_case)
            (cons (make Manager_result.delegation_case) []))))).

Reserved Notation "'contents_result".

Inductive contents_result_gadt : Set :=
| Endorsement_result :
  Tezos_raw_protocol_alpha.Alpha_context.Delegate.balance_updates ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  list Z -> contents_result_gadt
| Seed_nonce_revelation_result :
  Tezos_raw_protocol_alpha.Alpha_context.Delegate.balance_updates ->
  contents_result_gadt
| Double_endorsement_evidence_result :
  Tezos_raw_protocol_alpha.Alpha_context.Delegate.balance_updates ->
  contents_result_gadt
| Double_baking_evidence_result :
  Tezos_raw_protocol_alpha.Alpha_context.Delegate.balance_updates ->
  contents_result_gadt
| Activate_account_result :
  Tezos_raw_protocol_alpha.Alpha_context.Delegate.balance_updates ->
  contents_result_gadt
| Proposals_result : contents_result_gadt
| Ballot_result : contents_result_gadt
| Manager_operation_result : forall {kind : Set},
  Tezos_raw_protocol_alpha.Alpha_context.Delegate.balance_updates ->
  manager_operation_result kind -> list packed_internal_operation_result ->
  contents_result_gadt

where "'contents_result" := (fun (kind : Set) => contents_result_gadt).

Definition contents_result := 'contents_result.

Reserved Notation "'packed_contents_result".

Inductive packed_contents_result_gadt : Set :=
| Contents_result : forall {kind : Set},
  contents_result kind -> packed_contents_result_gadt

where "'packed_contents_result" := (packed_contents_result_gadt).

Definition packed_contents_result := 'packed_contents_result.

Reserved Notation "'packed_contents_and_result".

Inductive packed_contents_and_result_gadt : Set :=
| Contents_and_result : forall {kind : Set},
  Tezos_raw_protocol_alpha.Alpha_context.Operation.contents kind ->
  contents_result kind -> packed_contents_and_result_gadt

where "'packed_contents_and_result" := (packed_contents_and_result_gadt).

Definition packed_contents_and_result := 'packed_contents_and_result.

Reserved Notation "'eq".

Inductive eq_gadt : Set :=
| Eq : eq_gadt

where "'eq" := (fun (a b : Set) => eq_gadt).

Definition eq := 'eq.

Definition equal_manager_kind {a b : Set}
  (ka : Tezos_raw_protocol_alpha.Alpha_context.Kind.manager a)
  (kb : Tezos_raw_protocol_alpha.Alpha_context.Kind.manager b)
  : option (eq a b) :=
  match (ka, kb) with
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Kind.Reveal_manager_kind,
      Tezos_raw_protocol_alpha.Alpha_context.Kind.Reveal_manager_kind) =>
    Some Eq
  | (Tezos_raw_protocol_alpha.Alpha_context.Kind.Reveal_manager_kind, _) => None
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Kind.Transaction_manager_kind,
      Tezos_raw_protocol_alpha.Alpha_context.Kind.Transaction_manager_kind) =>
    Some Eq
  | (Tezos_raw_protocol_alpha.Alpha_context.Kind.Transaction_manager_kind, _) =>
    None
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Kind.Origination_manager_kind,
      Tezos_raw_protocol_alpha.Alpha_context.Kind.Origination_manager_kind) =>
    Some Eq
  | (Tezos_raw_protocol_alpha.Alpha_context.Kind.Origination_manager_kind, _) =>
    None
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Kind.Delegation_manager_kind,
      Tezos_raw_protocol_alpha.Alpha_context.Kind.Delegation_manager_kind) =>
    Some Eq
  | (Tezos_raw_protocol_alpha.Alpha_context.Kind.Delegation_manager_kind, _) =>
    None
  end.

Module Encoding.
  Reserved Notation "'case".
  
  Inductive case_gadt : Set :=
  | Case : forall {a kind : Set},
    Tezos_raw_protocol_alpha.Alpha_context.Operation.Encoding.case kind ->
    Tezos_protocol_environment_alpha__Environment.Data_encoding.t a ->
    (packed_contents_result -> option (contents_result kind)) ->
    (packed_contents_and_result ->
    option
      (Tezos_raw_protocol_alpha.Alpha_context.contents kind *
        contents_result kind)) -> (contents_result kind -> a) ->
    (a -> contents_result kind) -> case_gadt
  
  where "'case" := (fun (kind : Set) => case_gadt).
  
  Definition case := 'case.
  
  Definition tagged_case {A B : Set}
    (tag : Tezos_protocol_environment_alpha__Environment.Data_encoding.case_tag)
    (name : string)
    (args :
      Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding A)
    (proj : B -> option A) (inj : A -> B)
    : Tezos_protocol_environment_alpha__Environment.Data_encoding.case B :=
    __case_value (String.capitalize_ascii name) None tag
      (merge_objs (obj1 (req None None "kind" % string (constant name))) args)
      (fun x =>
        match proj x with
        | None => None
        | Some x => Some (tt, x)
        end)
      (fun function_parameter =>
        let '(tt, x) := function_parameter in
        inj x).
  
  Definition endorsement_case
    : case Tezos_raw_protocol_alpha.Alpha_context.Kind.endorsement :=
    Case
      {| case.Case.op_case := Operation.Encoding.endorsement_case;
        case.Case.encoding :=
          obj3
            (req None None "balance_updates" % string
              Delegate.balance_updates_encoding)
            (req None None "delegate" % string
              Signature.Public_key_hash.encoding)
            (req None None "slots" % string (__list_value None uint8));
        case.Case.select :=
          fun function_parameter =>
            match function_parameter with
            | Contents_result ((Endorsement_result _) as op) => Some op
            | _ => None
            end;
        case.Case.mselect :=
          fun function_parameter =>
            match function_parameter with
            |
              Contents_and_result
                ((Tezos_raw_protocol_alpha.Alpha_context.Endorsement _) as op)
                res => Some (op, res)
            | _ => None
            end;
        case.Case.proj :=
          fun function_parameter =>
            let
              'Endorsement_result {|
                contents_result.Endorsement_result.balance_updates := balance_updates;
                  contents_result.Endorsement_result.delegate := delegate;
                  contents_result.Endorsement_result.slots := slots
                  |} := function_parameter in
            (balance_updates, delegate, slots);
        case.Case.inj :=
          fun function_parameter =>
            let '(balance_updates, delegate, slots) := function_parameter in
            Endorsement_result
              {|
                contents_result.Endorsement_result.balance_updates :=
                  balance_updates;
                contents_result.Endorsement_result.delegate := delegate;
                contents_result.Endorsement_result.slots := slots |} |}.
  
  Definition seed_nonce_revelation_case
    : case Tezos_raw_protocol_alpha.Alpha_context.Kind.seed_nonce_revelation :=
    Case
      {| case.Case.op_case := Operation.Encoding.seed_nonce_revelation_case;
        case.Case.encoding :=
          obj1
            (req None None "balance_updates" % string
              Delegate.balance_updates_encoding);
        case.Case.select :=
          fun function_parameter =>
            match function_parameter with
            | Contents_result ((Seed_nonce_revelation_result _) as op) =>
              Some op
            | _ => None
            end;
        case.Case.mselect :=
          fun function_parameter =>
            match function_parameter with
            |
              Contents_and_result
                ((Tezos_raw_protocol_alpha.Alpha_context.Seed_nonce_revelation _)
                  as op) res => Some (op, res)
            | _ => None
            end;
        case.Case.proj :=
          fun function_parameter =>
            let 'Seed_nonce_revelation_result bus := function_parameter in
            bus; case.Case.inj := fun bus => Seed_nonce_revelation_result bus |}.
  
  Definition double_endorsement_evidence_case
    : case
      Tezos_raw_protocol_alpha.Alpha_context.Kind.double_endorsement_evidence :=
    Case
      {|
        case.Case.op_case := Operation.Encoding.double_endorsement_evidence_case;
        case.Case.encoding :=
          obj1
            (req None None "balance_updates" % string
              Delegate.balance_updates_encoding);
        case.Case.select :=
          fun function_parameter =>
            match function_parameter with
            | Contents_result ((Double_endorsement_evidence_result _) as op) =>
              Some op
            | _ => None
            end;
        case.Case.mselect :=
          fun function_parameter =>
            match function_parameter with
            |
              Contents_and_result
                ((Tezos_raw_protocol_alpha.Alpha_context.Double_endorsement_evidence
                  _) as op) res => Some (op, res)
            | _ => None
            end;
        case.Case.proj :=
          fun function_parameter =>
            let 'Double_endorsement_evidence_result bus := function_parameter in
            bus;
        case.Case.inj := fun bus => Double_endorsement_evidence_result bus |}.
  
  Definition double_baking_evidence_case
    : case Tezos_raw_protocol_alpha.Alpha_context.Kind.double_baking_evidence :=
    Case
      {| case.Case.op_case := Operation.Encoding.double_baking_evidence_case;
        case.Case.encoding :=
          obj1
            (req None None "balance_updates" % string
              Delegate.balance_updates_encoding);
        case.Case.select :=
          fun function_parameter =>
            match function_parameter with
            | Contents_result ((Double_baking_evidence_result _) as op) =>
              Some op
            | _ => None
            end;
        case.Case.mselect :=
          fun function_parameter =>
            match function_parameter with
            |
              Contents_and_result
                ((Tezos_raw_protocol_alpha.Alpha_context.Double_baking_evidence
                  _) as op) res => Some (op, res)
            | _ => None
            end;
        case.Case.proj :=
          fun function_parameter =>
            let 'Double_baking_evidence_result bus := function_parameter in
            bus; case.Case.inj := fun bus => Double_baking_evidence_result bus
        |}.
  
  Definition activate_account_case
    : case Tezos_raw_protocol_alpha.Alpha_context.Kind.activate_account :=
    Case
      {| case.Case.op_case := Operation.Encoding.activate_account_case;
        case.Case.encoding :=
          obj1
            (req None None "balance_updates" % string
              Delegate.balance_updates_encoding);
        case.Case.select :=
          fun function_parameter =>
            match function_parameter with
            | Contents_result ((Activate_account_result _) as op) => Some op
            | _ => None
            end;
        case.Case.mselect :=
          fun function_parameter =>
            match function_parameter with
            |
              Contents_and_result
                ((Tezos_raw_protocol_alpha.Alpha_context.Activate_account _) as
                  op) res => Some (op, res)
            | _ => None
            end;
        case.Case.proj :=
          fun function_parameter =>
            let 'Activate_account_result bus := function_parameter in
            bus; case.Case.inj := fun bus => Activate_account_result bus |}.
  
  Definition proposals_case
    : case Tezos_raw_protocol_alpha__Alpha_context.Kind.proposals :=
    Case
      {| case.Case.op_case := Operation.Encoding.proposals_case;
        case.Case.encoding := Data_encoding.empty;
        case.Case.select :=
          fun function_parameter =>
            match function_parameter with
            | Contents_result (Proposals_result as op) => Some op
            | _ => None
            end;
        case.Case.mselect :=
          fun function_parameter =>
            match function_parameter with
            |
              Contents_and_result
                ((Tezos_raw_protocol_alpha.Alpha_context.Proposals _) as op) res
              => Some (op, res)
            | _ => None
            end;
        case.Case.proj :=
          fun function_parameter =>
            let 'Proposals_result := function_parameter in
            tt;
        case.Case.inj :=
          fun function_parameter =>
            let 'tt := function_parameter in
            Proposals_result |}.
  
  Definition ballot_case
    : case Tezos_raw_protocol_alpha__Alpha_context.Kind.ballot :=
    Case
      {| case.Case.op_case := Operation.Encoding.ballot_case;
        case.Case.encoding := Data_encoding.empty;
        case.Case.select :=
          fun function_parameter =>
            match function_parameter with
            | Contents_result (Ballot_result as op) => Some op
            | _ => None
            end;
        case.Case.mselect :=
          fun function_parameter =>
            match function_parameter with
            |
              Contents_and_result
                ((Tezos_raw_protocol_alpha.Alpha_context.Ballot _) as op) res =>
              Some (op, res)
            | _ => None
            end;
        case.Case.proj :=
          fun function_parameter =>
            let 'Ballot_result := function_parameter in
            tt;
        case.Case.inj :=
          fun function_parameter =>
            let 'tt := function_parameter in
            Ballot_result |}.
  
  Definition make_manager_case {A : Set}
    (function_parameter :
      Tezos_raw_protocol_alpha.Alpha_context.Operation.Encoding.case
        (Tezos_raw_protocol_alpha.Alpha_context.Kind.manager A))
    : Manager_result.case A ->
    (packed_contents_and_result ->
    option
      (Tezos_raw_protocol_alpha.Alpha_context.contents
        (Tezos_raw_protocol_alpha.Alpha_context.Kind.manager A) *
        contents_result (Tezos_raw_protocol_alpha.Alpha_context.Kind.manager A)))
    -> case (Tezos_raw_protocol_alpha.Alpha_context.Kind.manager A) :=
    let
      'Tezos_raw_protocol_alpha.Alpha_context.Operation.Encoding.Case op_case :=
      function_parameter in
    fun function_parameter =>
      let 'Manager_result.MCase res_case := function_parameter in
      fun mselect =>
        Case
          {|
            case.Case.op_case :=
              Tezos_raw_protocol_alpha.Alpha_context.Operation.Encoding.Case
                op_case;
            case.Case.encoding :=
              obj3
                (req None None "balance_updates" % string
                  Delegate.balance_updates_encoding)
                (req None None "operation_result" % string
                  (Manager_result.case.MCase.t res_case))
                (dft None None "internal_operation_results" % string
                  (__list_value None internal_operation_result_encoding) []);
            case.Case.select :=
              fun function_parameter =>
                match function_parameter with
                |
                  Contents_result
                    (Manager_operation_result
                      ({|
                        contents_result.Manager_operation_result.operation_result := Applied res
                          |} as op)) =>
                  match
                    (Manager_result.case.MCase.select res_case)
                      (Successful_manager_result res) with
                  | Some res =>
                    Some
                      (Manager_operation_result
                        (* ❌ Record substitution not handled *)
                        record_substitution)
                  | None => None
                  end
                |
                  Contents_result
                    (Manager_operation_result
                      ({|
                        contents_result.Manager_operation_result.operation_result :=
                          Backtracked res errs
                          |} as op)) =>
                  match
                    (Manager_result.case.MCase.select res_case)
                      (Successful_manager_result res) with
                  | Some res =>
                    Some
                      (Manager_operation_result
                        (* ❌ Record substitution not handled *)
                        record_substitution)
                  | None => None
                  end
                |
                  Contents_result
                    (Manager_operation_result
                      ({|
                        contents_result.Manager_operation_result.operation_result := Skipped kind
                          |} as op)) =>
                  match
                    equal_manager_kind kind
                      (Manager_result.case.MCase.kind res_case) with
                  | None => None
                  | Some Eq =>
                    Some
                      (Manager_operation_result
                        (* ❌ Record substitution not handled *)
                        record_substitution)
                  end
                |
                  Contents_result
                    (Manager_operation_result
                      ({|
                        contents_result.Manager_operation_result.operation_result := Failed kind errs
                          |} as op)) =>
                  match
                    equal_manager_kind kind
                      (Manager_result.case.MCase.kind res_case) with
                  | None => None
                  | Some Eq =>
                    Some
                      (Manager_operation_result
                        (* ❌ Record substitution not handled *)
                        record_substitution)
                  end
                | Contents_result Ballot_result => None
                | Contents_result (Endorsement_result _) => None
                | Contents_result (Seed_nonce_revelation_result _) => None
                | Contents_result (Double_endorsement_evidence_result _) => None
                | Contents_result (Double_baking_evidence_result _) => None
                | Contents_result (Activate_account_result _) => None
                | Contents_result Proposals_result => None
                end; case.Case.mselect := mselect;
            case.Case.proj :=
              fun function_parameter =>
                let
                  'Manager_operation_result {|
                    contents_result.Manager_operation_result.balance_updates := bus;
                      contents_result.Manager_operation_result.operation_result
                        := r;
                      contents_result.Manager_operation_result.internal_operation_results
                        := rs
                      |} := function_parameter in
                (bus, r, rs);
            case.Case.inj :=
              fun function_parameter =>
                let '(bus, r, rs) := function_parameter in
                Manager_operation_result
                  {|
                    contents_result.Manager_operation_result.balance_updates :=
                      bus;
                    contents_result.Manager_operation_result.operation_result :=
                      r;
                    contents_result.Manager_operation_result.internal_operation_results :=
                      rs |} |}.
  
  Definition reveal_case
    : case
      (Tezos_raw_protocol_alpha.Alpha_context.Kind.manager
        Tezos_raw_protocol_alpha.Alpha_context.Kind.reveal) :=
    make_manager_case Operation.Encoding.reveal_case Manager_result.reveal_case
      (fun function_parameter =>
        match function_parameter with
        |
          Contents_and_result
            ((Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
              Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.operation :=
                Tezos_raw_protocol_alpha.Alpha_context.Reveal _
                |}) as op) res => Some (op, res)
        | _ => None
        end).
  
  Definition transaction_case
    : case
      (Tezos_raw_protocol_alpha.Alpha_context.Kind.manager
        Tezos_raw_protocol_alpha.Alpha_context.Kind.transaction) :=
    make_manager_case Operation.Encoding.transaction_case
      Manager_result.transaction_case
      (fun function_parameter =>
        match function_parameter with
        |
          Contents_and_result
            ((Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
              Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.operation :=
                Tezos_raw_protocol_alpha.Alpha_context.Transaction _
                |}) as op) res => Some (op, res)
        | _ => None
        end).
  
  Definition origination_case
    : case
      (Tezos_raw_protocol_alpha.Alpha_context.Kind.manager
        Tezos_raw_protocol_alpha.Alpha_context.Kind.origination) :=
    make_manager_case Operation.Encoding.origination_case
      Manager_result.origination_case
      (fun function_parameter =>
        match function_parameter with
        |
          Contents_and_result
            ((Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
              Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.operation :=
                Tezos_raw_protocol_alpha.Alpha_context.Origination _
                |}) as op) res => Some (op, res)
        | _ => None
        end).
  
  Definition delegation_case
    : case
      (Tezos_raw_protocol_alpha.Alpha_context.Kind.manager
        Tezos_raw_protocol_alpha.Alpha_context.Kind.delegation) :=
    make_manager_case Operation.Encoding.delegation_case
      Manager_result.delegation_case
      (fun function_parameter =>
        match function_parameter with
        |
          Contents_and_result
            ((Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
              Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.operation :=
                Tezos_raw_protocol_alpha.Alpha_context.Delegation _
                |}) as op) res => Some (op, res)
        | _ => None
        end).
End Encoding.

Definition contents_result_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    packed_contents_result :=
  let make {A : Set} (function_parameter : Encoding.case A)
    : Tezos_protocol_environment_alpha__Environment.Data_encoding.case
      packed_contents_result :=
    let
      'Encoding.Case {|
        Encoding.case.Case.op_case :=
          Tezos_raw_protocol_alpha.Alpha_context.Operation.Encoding.Case {|
            Tezos_raw_protocol_alpha.Alpha_context.Operation.Encoding.case.Case.tag
              := tag;
              Tezos_raw_protocol_alpha.Alpha_context.Operation.Encoding.case.Case.name
                := name
              |};
          Encoding.case.Case.encoding := encoding;
          Encoding.case.Case.select := select;
          Encoding.case.Case.mselect := _;
          Encoding.case.Case.proj := proj;
          Encoding.case.Case.inj := inj
          |} := function_parameter in
    let proj (x : packed_contents_result) : option op_dollarCase_'a :=
      match select x with
      | None => None
      | Some x => Some (proj x)
      end in
    let inj (x : op_dollarCase_'a) : packed_contents_result :=
      Contents_result (inj x) in
    tagged_case
      (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag tag) name
      encoding proj inj in
  op_atat
    (let arg := def "operation.alpha.contents_result" % string in
    fun eta => arg None None eta)
    (union None
      (cons (make endorsement_case)
        (cons (make seed_nonce_revelation_case)
          (cons (make double_endorsement_evidence_case)
            (cons (make double_baking_evidence_case)
              (cons (make activate_account_case)
                (cons (make proposals_case)
                  (cons (make ballot_case)
                    (cons (make reveal_case)
                      (cons (make transaction_case)
                        (cons (make origination_case)
                          (cons (make delegation_case) [])))))))))))).

Definition contents_and_result_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    packed_contents_and_result :=
  let make {A : Set} (function_parameter : Encoding.case A)
    : Tezos_protocol_environment_alpha__Environment.Data_encoding.case
      packed_contents_and_result :=
    let
      'Encoding.Case {|
        Encoding.case.Case.op_case :=
          Tezos_raw_protocol_alpha.Alpha_context.Operation.Encoding.Case {|
            Tezos_raw_protocol_alpha.Alpha_context.Operation.Encoding.case.Case.tag
              := tag;
              Tezos_raw_protocol_alpha.Alpha_context.Operation.Encoding.case.Case.name
                := name;
              Tezos_raw_protocol_alpha.Alpha_context.Operation.Encoding.case.Case.encoding
                := encoding;
              Tezos_raw_protocol_alpha.Alpha_context.Operation.Encoding.case.Case.proj
                := proj;
              Tezos_raw_protocol_alpha.Alpha_context.Operation.Encoding.case.Case.inj
                := inj
              |};
          Encoding.case.Case.encoding := meta_encoding;
          Encoding.case.Case.mselect := mselect;
          Encoding.case.Case.proj := meta_proj;
          Encoding.case.Case.inj := meta_inj
          |} := function_parameter in
    let proj (c : packed_contents_and_result)
      : option (op_dollarCase_'a1 * op_dollarCase_'a) :=
      match mselect c with
      | Some (op, res) => Some ((proj op), (meta_proj res))
      | _ => None
      end in
    let inj (function_parameter : op_dollarCase_'a1 * op_dollarCase_'a)
      : packed_contents_and_result :=
      let '(op, res) := function_parameter in
      Contents_and_result (inj op) (meta_inj res) in
    let encoding :=
      merge_objs encoding
        (obj1 (req None None "metadata" % string meta_encoding)) in
    tagged_case
      (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag tag) name
      encoding proj inj in
  op_atat
    (let arg := def "operation.alpha.operation_contents_and_result" % string in
    fun eta => arg None None eta)
    (union None
      (cons (make endorsement_case)
        (cons (make seed_nonce_revelation_case)
          (cons (make double_endorsement_evidence_case)
            (cons (make double_baking_evidence_case)
              (cons (make activate_account_case)
                (cons (make proposals_case)
                  (cons (make ballot_case)
                    (cons (make reveal_case)
                      (cons (make transaction_case)
                        (cons (make origination_case)
                          (cons (make delegation_case) [])))))))))))).

Reserved Notation "'contents_result_list".

Inductive contents_result_list_gadt : Set :=
| Single_result : forall {kind : Set},
  contents_result kind -> contents_result_list_gadt
| Cons_result : forall {kind : Set},
  contents_result (Tezos_raw_protocol_alpha.Alpha_context.Kind.manager kind) ->
  contents_result_list_gadt -> contents_result_list_gadt

where "'contents_result_list" := (fun (kind : Set) => contents_result_list_gadt).

Definition contents_result_list := 'contents_result_list.

Reserved Notation "'packed_contents_result_list".

Inductive packed_contents_result_list_gadt : Set :=
| Contents_result_list : forall {kind : Set},
  contents_result_list kind -> packed_contents_result_list_gadt

where "'packed_contents_result_list" := (packed_contents_result_list_gadt).

Definition packed_contents_result_list := 'packed_contents_result_list.

Definition contents_result_list_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    packed_contents_result_list :=
  let fix to_list (function_parameter : packed_contents_result_list)
    : list packed_contents_result :=
    match function_parameter with
    | Contents_result_list (Single_result o) => cons (Contents_result o) []
    | Contents_result_list (Cons_result o os) =>
      cons (Contents_result o) (to_list (Contents_result_list os))
    end in
  let fix of_list (function_parameter : list packed_contents_result)
    : packed_contents_result_list :=
    match function_parameter with
    | [] => Pervasives.failwith "cannot decode empty operation result" % string
    | cons (Contents_result o) [] => Contents_result_list (Single_result o)
    | cons (Contents_result o) os =>
      let 'Contents_result_list os := of_list os in
      match (o, os) with
      | (Manager_operation_result _, Single_result (Manager_operation_result _))
        => Contents_result_list (Cons_result o os)
      | (Manager_operation_result _, Cons_result _ _) =>
        Contents_result_list (Cons_result o os)
      | _ =>
        Pervasives.failwith "cannot decode ill-formed operation result" % string
      end
    end in
  op_atat
    (let arg := def "operation.alpha.contents_list_result" % string in
    fun eta => arg None None eta)
    (conv to_list of_list None (__list_value None contents_result_encoding)).

Reserved Notation "'contents_and_result_list".

Inductive contents_and_result_list_gadt : Set :=
| Single_and_result : forall {kind : Set},
  Tezos_raw_protocol_alpha.Alpha_context.contents kind ->
  contents_result kind -> contents_and_result_list_gadt
| Cons_and_result : forall {kind : Set},
  Tezos_raw_protocol_alpha.Alpha_context.contents
    (Tezos_raw_protocol_alpha.Alpha_context.Kind.manager kind) ->
  contents_result (Tezos_raw_protocol_alpha.Alpha_context.Kind.manager kind) ->
  contents_and_result_list_gadt -> contents_and_result_list_gadt

where "'contents_and_result_list" := (fun (kind : Set) =>
  contents_and_result_list_gadt).

Definition contents_and_result_list := 'contents_and_result_list.

Reserved Notation "'packed_contents_and_result_list".

Inductive packed_contents_and_result_list_gadt : Set :=
| Contents_and_result_list : forall {kind : Set},
  contents_and_result_list kind -> packed_contents_and_result_list_gadt

where "'packed_contents_and_result_list" :=
  (packed_contents_and_result_list_gadt).

Definition packed_contents_and_result_list := 'packed_contents_and_result_list.

Definition contents_and_result_list_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    packed_contents_and_result_list :=
  let fix to_list (function_parameter : packed_contents_and_result_list)
    : list packed_contents_and_result :=
    match function_parameter with
    | Contents_and_result_list (Single_and_result op res) =>
      cons (Contents_and_result op res) []
    | Contents_and_result_list (Cons_and_result op res rest) =>
      cons (Contents_and_result op res)
        (to_list (Contents_and_result_list rest))
    end in
  let fix of_list (function_parameter : list packed_contents_and_result)
    : packed_contents_and_result_list :=
    match function_parameter with
    | [] =>
      Pervasives.failwith
        "cannot decode empty combined operation result" % string
    | cons (Contents_and_result op res) [] =>
      Contents_and_result_list (Single_and_result op res)
    | cons (Contents_and_result op res) rest =>
      let 'Contents_and_result_list rest := of_list rest in
      match (op, rest) with
      |
        (Tezos_raw_protocol_alpha.Alpha_context.Manager_operation _,
          Single_and_result
            (Tezos_raw_protocol_alpha.Alpha_context.Manager_operation _) _) =>
        Contents_and_result_list (Cons_and_result op res rest)
      |
        (Tezos_raw_protocol_alpha.Alpha_context.Manager_operation _,
          Cons_and_result _ _ _) =>
        Contents_and_result_list (Cons_and_result op res rest)
      | _ =>
        Pervasives.failwith
          "cannot decode ill-formed combined operation result" % string
      end
    end in
  conv to_list of_list None
    (__Variable.__list_value None contents_and_result_encoding).

Module operation_metadata.
  Record record {kind : Set} := {
    contents : contents_result_list kind }.
  Arguments record : clear implicits.
End operation_metadata.
Definition operation_metadata := operation_metadata.record.

Reserved Notation "'packed_operation_metadata".

Inductive packed_operation_metadata_gadt : Set :=
| Operation_metadata : forall {kind : Set},
  operation_metadata kind -> packed_operation_metadata_gadt
| No_operation_metadata : packed_operation_metadata_gadt

where "'packed_operation_metadata" := (packed_operation_metadata_gadt).

Definition packed_operation_metadata := 'packed_operation_metadata.

Definition operation_metadata_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    packed_operation_metadata :=
  op_atat
    (let arg := def "operation.alpha.result" % string in
    fun eta => arg None None eta)
    (union None
      (cons
        (__case_value "Operation_metadata" % string None
          (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag 0)
          contents_result_list_encoding
          (fun function_parameter =>
            match function_parameter with
            | Operation_metadata {| operation_metadata.contents := contents |}
              => Some (Contents_result_list contents)
            | _ => None
            end)
          (fun function_parameter =>
            let 'Contents_result_list contents := function_parameter in
            Operation_metadata {| operation_metadata.contents := contents |}))
        (cons
          (__case_value "No_operation_metadata" % string None
            (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag 1)
            empty
            (fun function_parameter =>
              match function_parameter with
              | No_operation_metadata => Some tt
              | _ => None
              end)
            (fun function_parameter =>
              let 'tt := function_parameter in
              No_operation_metadata)) []))).

Definition kind_equal {kind kind2 : Set}
  (op : Tezos_raw_protocol_alpha.Alpha_context.contents kind)
  (res : contents_result kind2) : option (eq kind kind2) :=
  match (op, res) with
  | (Tezos_raw_protocol_alpha.Alpha_context.Endorsement _, Endorsement_result _)
    => Some Eq
  | (Tezos_raw_protocol_alpha.Alpha_context.Endorsement _, _) => None
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Seed_nonce_revelation _,
      Seed_nonce_revelation_result _) => Some Eq
  | (Tezos_raw_protocol_alpha.Alpha_context.Seed_nonce_revelation _, _) => None
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Double_endorsement_evidence _,
      Double_endorsement_evidence_result _) => Some Eq
  | (Tezos_raw_protocol_alpha.Alpha_context.Double_endorsement_evidence _, _) =>
    None
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Double_baking_evidence _,
      Double_baking_evidence_result _) => Some Eq
  | (Tezos_raw_protocol_alpha.Alpha_context.Double_baking_evidence _, _) => None
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Activate_account _,
      Activate_account_result _) => Some Eq
  | (Tezos_raw_protocol_alpha.Alpha_context.Activate_account _, _) => None
  | (Tezos_raw_protocol_alpha.Alpha_context.Proposals _, Proposals_result) =>
    Some Eq
  | (Tezos_raw_protocol_alpha.Alpha_context.Proposals _, _) => None
  | (Tezos_raw_protocol_alpha.Alpha_context.Ballot _, Ballot_result) => Some Eq
  | (Tezos_raw_protocol_alpha.Alpha_context.Ballot _, _) => None
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
      Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.operation :=
        Tezos_raw_protocol_alpha.Alpha_context.Reveal _
        |},
      Manager_operation_result {|
        contents_result.Manager_operation_result.operation_result :=
          Applied (Reveal_result _)
          |}) => Some Eq
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
      Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.operation :=
        Tezos_raw_protocol_alpha.Alpha_context.Reveal _
        |},
      Manager_operation_result {|
        contents_result.Manager_operation_result.operation_result :=
          Backtracked (Reveal_result _) _
          |}) => Some Eq
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
      Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.operation :=
        Tezos_raw_protocol_alpha.Alpha_context.Reveal _
        |},
      Manager_operation_result {|
        contents_result.Manager_operation_result.operation_result :=
          Failed Tezos_raw_protocol_alpha.Alpha_context.Kind.Reveal_manager_kind
            _
          |}) => Some Eq
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
      Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.operation :=
        Tezos_raw_protocol_alpha.Alpha_context.Reveal _
        |},
      Manager_operation_result {|
        contents_result.Manager_operation_result.operation_result :=
          Skipped
            Tezos_raw_protocol_alpha.Alpha_context.Kind.Reveal_manager_kind
          |}) => Some Eq
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
      Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.operation :=
        Tezos_raw_protocol_alpha.Alpha_context.Reveal _
        |}, _) => None
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
      Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.operation :=
        Tezos_raw_protocol_alpha.Alpha_context.Transaction _
        |},
      Manager_operation_result {|
        contents_result.Manager_operation_result.operation_result :=
          Applied (Transaction_result _)
          |}) => Some Eq
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
      Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.operation :=
        Tezos_raw_protocol_alpha.Alpha_context.Transaction _
        |},
      Manager_operation_result {|
        contents_result.Manager_operation_result.operation_result :=
          Backtracked (Transaction_result _) _
          |}) => Some Eq
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
      Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.operation :=
        Tezos_raw_protocol_alpha.Alpha_context.Transaction _
        |},
      Manager_operation_result {|
        contents_result.Manager_operation_result.operation_result :=
          Failed
            Tezos_raw_protocol_alpha.Alpha_context.Kind.Transaction_manager_kind
            _
          |}) => Some Eq
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
      Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.operation :=
        Tezos_raw_protocol_alpha.Alpha_context.Transaction _
        |},
      Manager_operation_result {|
        contents_result.Manager_operation_result.operation_result :=
          Skipped
            Tezos_raw_protocol_alpha.Alpha_context.Kind.Transaction_manager_kind
          |}) => Some Eq
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
      Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.operation :=
        Tezos_raw_protocol_alpha.Alpha_context.Transaction _
        |}, _) => None
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
      Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.operation :=
        Tezos_raw_protocol_alpha.Alpha_context.Origination _
        |},
      Manager_operation_result {|
        contents_result.Manager_operation_result.operation_result :=
          Applied (Origination_result _)
          |}) => Some Eq
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
      Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.operation :=
        Tezos_raw_protocol_alpha.Alpha_context.Origination _
        |},
      Manager_operation_result {|
        contents_result.Manager_operation_result.operation_result :=
          Backtracked (Origination_result _) _
          |}) => Some Eq
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
      Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.operation :=
        Tezos_raw_protocol_alpha.Alpha_context.Origination _
        |},
      Manager_operation_result {|
        contents_result.Manager_operation_result.operation_result :=
          Failed
            Tezos_raw_protocol_alpha.Alpha_context.Kind.Origination_manager_kind
            _
          |}) => Some Eq
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
      Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.operation :=
        Tezos_raw_protocol_alpha.Alpha_context.Origination _
        |},
      Manager_operation_result {|
        contents_result.Manager_operation_result.operation_result :=
          Skipped
            Tezos_raw_protocol_alpha.Alpha_context.Kind.Origination_manager_kind
          |}) => Some Eq
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
      Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.operation :=
        Tezos_raw_protocol_alpha.Alpha_context.Origination _
        |}, _) => None
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
      Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.operation :=
        Tezos_raw_protocol_alpha.Alpha_context.Delegation _
        |},
      Manager_operation_result {|
        contents_result.Manager_operation_result.operation_result :=
          Applied (Delegation_result _)
          |}) => Some Eq
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
      Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.operation :=
        Tezos_raw_protocol_alpha.Alpha_context.Delegation _
        |},
      Manager_operation_result {|
        contents_result.Manager_operation_result.operation_result :=
          Backtracked (Delegation_result _) _
          |}) => Some Eq
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
      Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.operation :=
        Tezos_raw_protocol_alpha.Alpha_context.Delegation _
        |},
      Manager_operation_result {|
        contents_result.Manager_operation_result.operation_result :=
          Failed
            Tezos_raw_protocol_alpha.Alpha_context.Kind.Delegation_manager_kind
            _
          |}) => Some Eq
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
      Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.operation :=
        Tezos_raw_protocol_alpha.Alpha_context.Delegation _
        |},
      Manager_operation_result {|
        contents_result.Manager_operation_result.operation_result :=
          Skipped
            Tezos_raw_protocol_alpha.Alpha_context.Kind.Delegation_manager_kind
          |}) => Some Eq
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
      Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.operation :=
        Tezos_raw_protocol_alpha.Alpha_context.Delegation _
        |}, _) => None
  end.

Fixpoint kind_equal_list {kind kind2 : Set}
  (contents : Tezos_raw_protocol_alpha.Alpha_context.contents_list kind)
  (res : contents_result_list kind2) : option (eq kind kind2) :=
  match (contents, res) with
  | (Tezos_raw_protocol_alpha.Alpha_context.Single op, Single_result res) =>
    match kind_equal op res with
    | None => None
    | Some Eq => Some Eq
    end
  | (Tezos_raw_protocol_alpha.Alpha_context.Cons op ops, Cons_result res ress)
    =>
    match kind_equal op res with
    | None => None
    | Some Eq =>
      match kind_equal_list ops ress with
      | None => None
      | Some Eq => Some Eq
      end
    end
  | _ => None
  end.

Fixpoint pack_contents_list {kind : Set}
  (contents : Tezos_raw_protocol_alpha.Alpha_context.contents_list kind)
  (res : contents_result_list kind) : contents_and_result_list kind :=
  match (contents, res) with
  | (Tezos_raw_protocol_alpha.Alpha_context.Single op, Single_result res) =>
    Single_and_result op res
  | (Tezos_raw_protocol_alpha.Alpha_context.Cons op ops, Cons_result res ress)
    => Cons_and_result op res (pack_contents_list ops ress)
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Single
      (Tezos_raw_protocol_alpha.Alpha_context.Manager_operation _),
      Cons_result (Manager_operation_result _) (Single_result _)) =>
    (* ❌ Unreachable expressions are not supported *)
    unreachable
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Cons _ _,
      Single_result
        (Manager_operation_result {|
          contents_result.Manager_operation_result.operation_result := Failed _ _
            |})) =>
    (* ❌ Unreachable expressions are not supported *)
    unreachable
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Cons _ _,
      Single_result
        (Manager_operation_result {|
          contents_result.Manager_operation_result.operation_result := Skipped _
            |})) =>
    (* ❌ Unreachable expressions are not supported *)
    unreachable
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Cons _ _,
      Single_result
        (Manager_operation_result {|
          contents_result.Manager_operation_result.operation_result := Applied _
            |})) =>
    (* ❌ Unreachable expressions are not supported *)
    unreachable
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Cons _ _,
      Single_result
        (Manager_operation_result {|
          contents_result.Manager_operation_result.operation_result := Backtracked _ _
            |})) =>
    (* ❌ Unreachable expressions are not supported *)
    unreachable
  | (Tezos_raw_protocol_alpha.Alpha_context.Single _, Cons_result _ _) =>
    (* ❌ Unreachable expressions are not supported *)
    unreachable
  end.

Fixpoint unpack_contents_list {kind : Set}
  (function_parameter : contents_and_result_list kind)
  : Tezos_raw_protocol_alpha.Alpha_context.contents_list kind *
    contents_result_list kind :=
  match function_parameter with
  | Single_and_result op res =>
    ((Tezos_raw_protocol_alpha.Alpha_context.Single op), (Single_result res))
  | Cons_and_result op res rest =>
    let '(ops, ress) := unpack_contents_list rest in
    ((Tezos_raw_protocol_alpha.Alpha_context.Cons op ops),
      (Cons_result res ress))
  end.

Fixpoint to_list (function_parameter : packed_contents_result_list)
  : list packed_contents_result :=
  match function_parameter with
  | Contents_result_list (Single_result o) => cons (Contents_result o) []
  | Contents_result_list (Cons_result o os) =>
    cons (Contents_result o) (to_list (Contents_result_list os))
  end.

Fixpoint of_list (function_parameter : list packed_contents_result)
  : packed_contents_result_list :=
  match function_parameter with
  | [] =>
    (* ❌ Assert instruction is not handled. *)
    assert false
  | cons (Contents_result o) [] => Contents_result_list (Single_result o)
  | cons (Contents_result o) os =>
    let 'Contents_result_list os := of_list os in
    match (o, os) with
    | (Manager_operation_result _, Single_result (Manager_operation_result _))
      => Contents_result_list (Cons_result o os)
    | (Manager_operation_result _, Cons_result _ _) =>
      Contents_result_list (Cons_result o os)
    | _ =>
      Pervasives.failwith
        "Operation result list of length > 1 should only contains manager operations result."
          % string
    end
  end.

Definition operation_data_and_metadata_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    (Tezos_raw_protocol_alpha.Alpha_context.packed_protocol_data *
      packed_operation_metadata) :=
  op_atat
    (let arg := def "operation.alpha.operation_with_metadata" % string in
    fun eta => arg None None eta)
    (union None
      (cons
        (__case_value "Operation_with_metadata" % string None
          (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag 0)
          (obj2
            (req None None "contents" % string
              (dynamic_size None contents_and_result_list_encoding))
            (opt None None "signature" % string Signature.encoding))
          (fun function_parameter =>
            match function_parameter with
            |
              (Tezos_raw_protocol_alpha.Alpha_context.Operation_data _,
                No_operation_metadata) => None
            |
              (Tezos_raw_protocol_alpha.Alpha_context.Operation_data op,
                Operation_metadata res) =>
              match
                kind_equal_list
                  (Tezos_raw_protocol_alpha.Alpha_context.protocol_data.contents
                    op) (operation_metadata.contents res) with
              | None =>
                Pervasives.failwith
                  "cannot decode inconsistent combined operation result" %
                    string
              | Some Eq =>
                Some
                  ((Contents_and_result_list
                    (pack_contents_list
                      (Tezos_raw_protocol_alpha.Alpha_context.protocol_data.contents
                        op) (operation_metadata.contents res))),
                    (Tezos_raw_protocol_alpha.Alpha_context.protocol_data.signature
                      op))
              end
            end)
          (fun function_parameter =>
            let '(Contents_and_result_list contents, signature) :=
              function_parameter in
            let '(op_contents, res_contents) := unpack_contents_list contents in
            ((Tezos_raw_protocol_alpha.Alpha_context.Operation_data
              {|
                Tezos_raw_protocol_alpha.Alpha_context.protocol_data.contents :=
                  op_contents;
                Tezos_raw_protocol_alpha.Alpha_context.protocol_data.signature :=
                  signature |}),
              (Operation_metadata
                {| operation_metadata.contents := res_contents |}))))
        (cons
          (__case_value "Operation_without_metadata" % string None
            (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag 1)
            (obj2
              (req None None "contents" % string
                (dynamic_size None Operation.contents_list_encoding))
              (opt None None "signature" % string Signature.encoding))
            (fun function_parameter =>
              match function_parameter with
              |
                (Tezos_raw_protocol_alpha.Alpha_context.Operation_data op,
                  No_operation_metadata) =>
                Some
                  ((Tezos_raw_protocol_alpha.Alpha_context.Contents_list
                    (Tezos_raw_protocol_alpha.Alpha_context.protocol_data.contents
                      op)),
                    (Tezos_raw_protocol_alpha.Alpha_context.protocol_data.signature
                      op))
              |
                (Tezos_raw_protocol_alpha.Alpha_context.Operation_data _,
                  Operation_metadata _) => None
              end)
            (fun function_parameter =>
              let
                '(Tezos_raw_protocol_alpha.Alpha_context.Contents_list contents,
                  signature) := function_parameter in
              ((Tezos_raw_protocol_alpha.Alpha_context.Operation_data
                {|
                  Tezos_raw_protocol_alpha.Alpha_context.protocol_data.contents :=
                    contents;
                  Tezos_raw_protocol_alpha.Alpha_context.protocol_data.signature :=
                    signature |}), No_operation_metadata))) []))).

Module block_metadata.
  Record record := {
    baker :
      Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t;
    level : Tezos_raw_protocol_alpha.Alpha_context.Level.t;
    voting_period_kind :
      Tezos_raw_protocol_alpha.Alpha_context.Voting_period.kind;
    nonce_hash : option Tezos_raw_protocol_alpha.Nonce_hash.t;
    consumed_gas : Tezos_protocol_environment_alpha__Environment.Z.t;
    deactivated :
      list
        Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t;
    balance_updates :
      Tezos_raw_protocol_alpha.Alpha_context.Delegate.balance_updates }.
End block_metadata.
Definition block_metadata := block_metadata.record.

Definition block_metadata_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    block_metadata :=
  op_atat
    (let arg := def "block_header.alpha.metadata" % string in
    fun eta => arg None None eta)
    (conv
      (fun function_parameter =>
        let '{|
          block_metadata.baker := baker;
            block_metadata.level := level;
            block_metadata.voting_period_kind := voting_period_kind;
            block_metadata.nonce_hash := nonce_hash;
            block_metadata.consumed_gas := consumed_gas;
            block_metadata.deactivated := deactivated;
            block_metadata.balance_updates := balance_updates
            |} := function_parameter in
        (baker, level, voting_period_kind, nonce_hash, consumed_gas,
          deactivated, balance_updates))
      (fun function_parameter =>
        let
          '(baker, level, voting_period_kind, nonce_hash, consumed_gas,
            deactivated, balance_updates) := function_parameter in
        {| block_metadata.baker := baker; block_metadata.level := level;
          block_metadata.voting_period_kind := voting_period_kind;
          block_metadata.nonce_hash := nonce_hash;
          block_metadata.consumed_gas := consumed_gas;
          block_metadata.deactivated := deactivated;
          block_metadata.balance_updates := balance_updates |}) None
      (obj7 (req None None "baker" % string Signature.Public_key_hash.encoding)
        (req None None "level" % string Level.encoding)
        (req None None "voting_period_kind" % string Voting_period.kind_encoding)
        (req None None "nonce_hash" % string
          (__option_value Nonce_hash.encoding))
        (req None None "consumed_gas" % string (check_size 10 n))
        (req None None "deactivated" % string
          (__list_value None Signature.Public_key_hash.encoding))
        (req None None "balance_updates" % string
          Delegate.balance_updates_encoding))).

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

(** Result of applying an operation, can be used for experimenting
    with protocol updates, by clients to print out a summary of the
    operation at pre-injection simulation and at confirmation time,
    and by block explorers. *)

open Alpha_context

(** Result of applying a {!Operation.t}. Follows the same structure. *)
type 'kind operation_metadata = {contents : 'kind contents_result_list}

and packed_operation_metadata =
  | Operation_metadata : 'kind operation_metadata -> packed_operation_metadata
  | No_operation_metadata : packed_operation_metadata

(** Result of applying a {!Operation.contents_list}. Follows the same structure. *)
and 'kind contents_result_list =
  | Single_result : 'kind contents_result -> 'kind contents_result_list
  | Cons_result :
      'kind Kind.manager contents_result
      * 'rest Kind.manager contents_result_list
      -> ('kind * 'rest) Kind.manager contents_result_list

and packed_contents_result_list =
  | Contents_result_list :
      'kind contents_result_list
      -> packed_contents_result_list

(** Result of applying an {!Operation.contents}. Follows the same structure. *)
and 'kind contents_result =
  | Endorsement_result : {
      balance_updates : Delegate.balance_updates;
      delegate : Signature.Public_key_hash.t;
      slots : int list;
    }
      -> Kind.endorsement contents_result
  | Seed_nonce_revelation_result :
      Delegate.balance_updates
      -> Kind.seed_nonce_revelation contents_result
  | Double_endorsement_evidence_result :
      Delegate.balance_updates
      -> Kind.double_endorsement_evidence contents_result
  | Double_baking_evidence_result :
      Delegate.balance_updates
      -> Kind.double_baking_evidence contents_result
  | Activate_account_result :
      Delegate.balance_updates
      -> Kind.activate_account contents_result
  | Proposals_result : Kind.proposals contents_result
  | Ballot_result : Kind.ballot contents_result
  | Manager_operation_result : {
      balance_updates : Delegate.balance_updates;
      operation_result : 'kind manager_operation_result;
      internal_operation_results : packed_internal_operation_result list;
    }
      -> 'kind Kind.manager contents_result

and packed_contents_result =
  | Contents_result : 'kind contents_result -> packed_contents_result

(** The result of an operation in the queue. [Skipped] ones should
    always be at the tail, and after a single [Failed]. *)
and 'kind manager_operation_result =
  | Applied of 'kind successful_manager_operation_result
  | Backtracked of
      'kind successful_manager_operation_result * error list option
  | Failed : 'kind Kind.manager * error list -> 'kind manager_operation_result
  | Skipped : 'kind Kind.manager -> 'kind manager_operation_result

(** Result of applying a {!manager_operation_content}, either internal
    or external. *)
and _ successful_manager_operation_result =
  | Reveal_result : {
      consumed_gas : Z.t;
    }
      -> Kind.reveal successful_manager_operation_result
  | Transaction_result : {
      storage : Script.expr option;
      big_map_diff : Contract.big_map_diff option;
      balance_updates : Delegate.balance_updates;
      originated_contracts : Contract.t list;
      consumed_gas : Z.t;
      storage_size : Z.t;
      paid_storage_size_diff : Z.t;
      allocated_destination_contract : bool;
    }
      -> Kind.transaction successful_manager_operation_result
  | Origination_result : {
      big_map_diff : Contract.big_map_diff option;
      balance_updates : Delegate.balance_updates;
      originated_contracts : Contract.t list;
      consumed_gas : Z.t;
      storage_size : Z.t;
      paid_storage_size_diff : Z.t;
    }
      -> Kind.origination successful_manager_operation_result
  | Delegation_result : {
      consumed_gas : Z.t;
    }
      -> Kind.delegation successful_manager_operation_result

and packed_successful_manager_operation_result =
  | Successful_manager_result :
      'kind successful_manager_operation_result
      -> packed_successful_manager_operation_result

and packed_internal_operation_result =
  | Internal_operation_result :
      'kind internal_operation * 'kind manager_operation_result
      -> packed_internal_operation_result

(** Serializer for {!packed_operation_result}. *)
val operation_metadata_encoding : packed_operation_metadata Data_encoding.t

val operation_data_and_metadata_encoding :
  (Operation.packed_protocol_data * packed_operation_metadata) Data_encoding.t

type 'kind contents_and_result_list =
  | Single_and_result :
      'kind Alpha_context.contents * 'kind contents_result
      -> 'kind contents_and_result_list
  | Cons_and_result :
      'kind Kind.manager Alpha_context.contents
      * 'kind Kind.manager contents_result
      * 'rest Kind.manager contents_and_result_list
      -> ('kind * 'rest) Kind.manager contents_and_result_list

type packed_contents_and_result_list =
  | Contents_and_result_list :
      'kind contents_and_result_list
      -> packed_contents_and_result_list

val contents_and_result_list_encoding :
  packed_contents_and_result_list Data_encoding.t

val pack_contents_list :
  'kind contents_list ->
  'kind contents_result_list ->
  'kind contents_and_result_list

val unpack_contents_list :
  'kind contents_and_result_list ->
  'kind contents_list * 'kind contents_result_list

val to_list : packed_contents_result_list -> packed_contents_result list

val of_list : packed_contents_result list -> packed_contents_result_list

type ('a, 'b) eq = Eq : ('a, 'a) eq

val kind_equal_list :
  'kind contents_list ->
  'kind2 contents_result_list ->
  ('kind, 'kind2) eq option

type block_metadata = {
  baker : Signature.Public_key_hash.t;
  level : Level.t;
  voting_period_kind : Voting_period.kind;
  nonce_hash : Nonce_hash.t option;
  consumed_gas : Z.t;
  deactivated : Signature.Public_key_hash.t list;
  balance_updates : Delegate.balance_updates;
}

val block_metadata_encoding : block_metadata Data_encoding.encoding

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Reserved Notation "'operation_metadata".
Reserved Notation "'packed_operation_metadata".
Reserved Notation "'contents_result_list".
Reserved Notation "'packed_contents_result_list".
Reserved Notation "'contents_result".
Reserved Notation "'packed_contents_result".
Reserved Notation "'manager_operation_result".
Reserved Notation "'successful_manager_operation_result".
Reserved Notation "'packed_successful_manager_operation_result".
Reserved Notation "'packed_internal_operation_result".

Module operation_metadata_skeleton.
  Record record {contents : Set} := {
    contents : contents }.
  Arguments record : clear implicits.
End operation_metadata_skeleton.
Definition operation_metadata_skeleton := operation_metadata_skeleton.record.

Inductive packed_operation_metadata_gadt : Set :=
| Operation_metadata : forall {kind : Set},
  'operation_metadata kind -> packed_operation_metadata_gadt
| No_operation_metadata : packed_operation_metadata_gadt

with contents_result_list_gadt : Set :=
| Single_result : forall {kind : Set},
  'contents_result kind -> contents_result_list_gadt
| Cons_result : forall {kind : Set},
  'contents_result (Tezos_raw_protocol_alpha.Alpha_context.Kind.manager kind) ->
  contents_result_list_gadt -> contents_result_list_gadt

with packed_contents_result_list_gadt : Set :=
| Contents_result_list : forall {kind : Set},
  'contents_result_list kind -> packed_contents_result_list_gadt

with contents_result_gadt : Set :=
| Endorsement_result :
  Tezos_raw_protocol_alpha.Alpha_context.Delegate.balance_updates ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  list Z -> contents_result_gadt
| Seed_nonce_revelation_result :
  Tezos_raw_protocol_alpha.Alpha_context.Delegate.balance_updates ->
  contents_result_gadt
| Double_endorsement_evidence_result :
  Tezos_raw_protocol_alpha.Alpha_context.Delegate.balance_updates ->
  contents_result_gadt
| Double_baking_evidence_result :
  Tezos_raw_protocol_alpha.Alpha_context.Delegate.balance_updates ->
  contents_result_gadt
| Activate_account_result :
  Tezos_raw_protocol_alpha.Alpha_context.Delegate.balance_updates ->
  contents_result_gadt
| Proposals_result : contents_result_gadt
| Ballot_result : contents_result_gadt
| Manager_operation_result : forall {kind : Set},
  Tezos_raw_protocol_alpha.Alpha_context.Delegate.balance_updates ->
  'manager_operation_result kind -> list 'packed_internal_operation_result ->
  contents_result_gadt

with packed_contents_result_gadt : Set :=
| Contents_result : forall {kind : Set},
  'contents_result kind -> packed_contents_result_gadt

with manager_operation_result_gadt : Set :=
| Applied : forall {kind : Set},
  'successful_manager_operation_result kind -> manager_operation_result_gadt
| Backtracked : forall {kind : Set},
  'successful_manager_operation_result kind ->
  option
    (list Tezos_protocol_environment_alpha__Environment.Error_monad.__error) ->
  manager_operation_result_gadt
| Failed : forall {kind : Set},
  Tezos_raw_protocol_alpha.Alpha_context.Kind.manager kind ->
  list Tezos_protocol_environment_alpha__Environment.Error_monad.__error ->
  manager_operation_result_gadt
| Skipped : forall {kind : Set},
  Tezos_raw_protocol_alpha.Alpha_context.Kind.manager kind ->
  manager_operation_result_gadt

with successful_manager_operation_result_gadt : Set :=
| Reveal_result :
  Tezos_protocol_environment_alpha__Environment.Z.t ->
  successful_manager_operation_result_gadt
| Transaction_result :
  option Tezos_raw_protocol_alpha.Alpha_context.Script.expr ->
  option Tezos_raw_protocol_alpha.Alpha_context.Contract.big_map_diff ->
  Tezos_raw_protocol_alpha.Alpha_context.Delegate.balance_updates ->
  list Tezos_raw_protocol_alpha.Alpha_context.Contract.t ->
  Tezos_protocol_environment_alpha__Environment.Z.t ->
  Tezos_protocol_environment_alpha__Environment.Z.t ->
  Tezos_protocol_environment_alpha__Environment.Z.t -> bool ->
  successful_manager_operation_result_gadt
| Origination_result :
  option Tezos_raw_protocol_alpha.Alpha_context.Contract.big_map_diff ->
  Tezos_raw_protocol_alpha.Alpha_context.Delegate.balance_updates ->
  list Tezos_raw_protocol_alpha.Alpha_context.Contract.t ->
  Tezos_protocol_environment_alpha__Environment.Z.t ->
  Tezos_protocol_environment_alpha__Environment.Z.t ->
  Tezos_protocol_environment_alpha__Environment.Z.t ->
  successful_manager_operation_result_gadt
| Delegation_result :
  Tezos_protocol_environment_alpha__Environment.Z.t ->
  successful_manager_operation_result_gadt

with packed_successful_manager_operation_result_gadt : Set :=
| Successful_manager_result : forall {kind : Set},
  'successful_manager_operation_result kind ->
  packed_successful_manager_operation_result_gadt

with packed_internal_operation_result_gadt : Set :=
| Internal_operation_result : forall {kind : Set},
  Tezos_raw_protocol_alpha.Alpha_context.internal_operation kind ->
  'manager_operation_result kind -> packed_internal_operation_result_gadt

where "'operation_metadata" := (fun (kind : Set) =>
  operation_metadata_skeleton ('contents_result_list kind))
and "'packed_operation_metadata" := (packed_operation_metadata_gadt)
and "'contents_result_list" := (fun (kind : Set) => contents_result_list_gadt)
and "'packed_contents_result_list" := (packed_contents_result_list_gadt)
and "'contents_result" := (fun (kind : Set) => contents_result_gadt)
and "'packed_contents_result" := (packed_contents_result_gadt)
and "'manager_operation_result" := (fun (kind : Set) =>
  manager_operation_result_gadt)
and "'successful_manager_operation_result" := (fun (_ : Set) =>
  successful_manager_operation_result_gadt)
and "'packed_successful_manager_operation_result" :=
  (packed_successful_manager_operation_result_gadt)
and "'packed_internal_operation_result" :=
  (packed_internal_operation_result_gadt).

Definition operation_metadata := 'operation_metadata.
Definition packed_operation_metadata := 'packed_operation_metadata.
Definition contents_result_list := 'contents_result_list.
Definition packed_contents_result_list := 'packed_contents_result_list.
Definition contents_result := 'contents_result.
Definition packed_contents_result := 'packed_contents_result.
Definition manager_operation_result := 'manager_operation_result.
Definition successful_manager_operation_result :=
  'successful_manager_operation_result.
Definition packed_successful_manager_operation_result :=
  'packed_successful_manager_operation_result.
Definition packed_internal_operation_result :=
  'packed_internal_operation_result.

Parameter operation_metadata_encoding :
  Tezos_protocol_environment_alpha__Environment.Data_encoding.t
    packed_operation_metadata.

Parameter operation_data_and_metadata_encoding :
  Tezos_protocol_environment_alpha__Environment.Data_encoding.t
    (Tezos_raw_protocol_alpha.Alpha_context.Operation.packed_protocol_data *
      packed_operation_metadata).

Reserved Notation "'contents_and_result_list".

Inductive contents_and_result_list_gadt : Set :=
| Single_and_result : forall {kind : Set},
  Tezos_raw_protocol_alpha.Alpha_context.contents kind ->
  contents_result kind -> contents_and_result_list_gadt
| Cons_and_result : forall {kind : Set},
  Tezos_raw_protocol_alpha.Alpha_context.contents
    (Tezos_raw_protocol_alpha.Alpha_context.Kind.manager kind) ->
  contents_result (Tezos_raw_protocol_alpha.Alpha_context.Kind.manager kind) ->
  contents_and_result_list_gadt -> contents_and_result_list_gadt

where "'contents_and_result_list" := (fun (kind : Set) =>
  contents_and_result_list_gadt).

Definition contents_and_result_list := 'contents_and_result_list.

Reserved Notation "'packed_contents_and_result_list".

Inductive packed_contents_and_result_list_gadt : Set :=
| Contents_and_result_list : forall {kind : Set},
  contents_and_result_list kind -> packed_contents_and_result_list_gadt

where "'packed_contents_and_result_list" :=
  (packed_contents_and_result_list_gadt).

Definition packed_contents_and_result_list := 'packed_contents_and_result_list.

Parameter contents_and_result_list_encoding :
  Tezos_protocol_environment_alpha__Environment.Data_encoding.t
    packed_contents_and_result_list.

Parameter pack_contents_list : forall {kind : Set},
  Tezos_raw_protocol_alpha.Alpha_context.contents_list kind ->
  contents_result_list kind -> contents_and_result_list kind.

Parameter unpack_contents_list : forall {kind : Set},
  contents_and_result_list kind ->
  Tezos_raw_protocol_alpha.Alpha_context.contents_list kind *
    contents_result_list kind.

Parameter to_list : packed_contents_result_list -> list packed_contents_result.

Parameter of_list : list packed_contents_result -> packed_contents_result_list.

Reserved Notation "'eq".

Inductive eq_gadt : Set :=
| Eq : eq_gadt

where "'eq" := (fun (a b : Set) => eq_gadt).

Definition eq := 'eq.

Parameter kind_equal_list : forall {kind kind2 : Set},
  Tezos_raw_protocol_alpha.Alpha_context.contents_list kind ->
  contents_result_list kind2 -> option (eq kind kind2).

Module block_metadata.
  Record record := {
    baker :
      Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t;
    level : Tezos_raw_protocol_alpha.Alpha_context.Level.t;
    voting_period_kind :
      Tezos_raw_protocol_alpha.Alpha_context.Voting_period.kind;
    nonce_hash : option Tezos_raw_protocol_alpha.Nonce_hash.t;
    consumed_gas : Tezos_protocol_environment_alpha__Environment.Z.t;
    deactivated :
      list
        Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t;
    balance_updates :
      Tezos_raw_protocol_alpha.Alpha_context.Delegate.balance_updates }.
End block_metadata.
Definition block_metadata := block_metadata.record.

Parameter block_metadata_encoding :
  Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    block_metadata.

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Alpha_context
open Misc

type error += Invalid_fitness_gap of int64 * int64 (* `Permanent *)

type error += Timestamp_too_early of Timestamp.t * Timestamp.t

(* `Permanent *)

type error += Unexpected_endorsement (* `Permanent *)

type error +=
  | Invalid_block_signature of Block_hash.t * Signature.Public_key_hash.t

(* `Permanent *)

type error += Invalid_signature (* `Permanent *)

type error += Invalid_stamp (* `Permanent *)

let () =
  register_error_kind
    `Permanent
    ~id:"baking.timestamp_too_early"
    ~title:"Block forged too early"
    ~description:
      "The block timestamp is before the first slot for this baker at this \
       level"
    ~pp:(fun ppf (r, p) ->
      Format.fprintf
        ppf
        "Block forged too early (%a is before %a)"
        Time.pp_hum
        p
        Time.pp_hum
        r)
    Data_encoding.(
      obj2 (req "minimum" Time.encoding) (req "provided" Time.encoding))
    (function Timestamp_too_early (r, p) -> Some (r, p) | _ -> None)
    (fun (r, p) -> Timestamp_too_early (r, p)) ;
  register_error_kind
    `Permanent
    ~id:"baking.invalid_fitness_gap"
    ~title:"Invalid fitness gap"
    ~description:"The gap of fitness is out of bounds"
    ~pp:(fun ppf (m, g) ->
      Format.fprintf ppf "The gap of fitness %Ld is not between 0 and %Ld" g m)
    Data_encoding.(obj2 (req "maximum" int64) (req "provided" int64))
    (function Invalid_fitness_gap (m, g) -> Some (m, g) | _ -> None)
    (fun (m, g) -> Invalid_fitness_gap (m, g)) ;
  register_error_kind
    `Permanent
    ~id:"baking.invalid_block_signature"
    ~title:"Invalid block signature"
    ~description:"A block was not signed with the expected private key."
    ~pp:(fun ppf (block, pkh) ->
      Format.fprintf
        ppf
        "Invalid signature for block %a. Expected: %a."
        Block_hash.pp_short
        block
        Signature.Public_key_hash.pp_short
        pkh)
    Data_encoding.(
      obj2
        (req "block" Block_hash.encoding)
        (req "expected" Signature.Public_key_hash.encoding))
    (function
      | Invalid_block_signature (block, pkh) -> Some (block, pkh) | _ -> None)
    (fun (block, pkh) -> Invalid_block_signature (block, pkh)) ;
  register_error_kind
    `Permanent
    ~id:"baking.invalid_signature"
    ~title:"Invalid block signature"
    ~description:"The block's signature is invalid"
    ~pp:(fun ppf () -> Format.fprintf ppf "Invalid block signature")
    Data_encoding.empty
    (function Invalid_signature -> Some () | _ -> None)
    (fun () -> Invalid_signature) ;
  register_error_kind
    `Permanent
    ~id:"baking.insufficient_proof_of_work"
    ~title:"Insufficient block proof-of-work stamp"
    ~description:"The block's proof-of-work stamp is insufficient"
    ~pp:(fun ppf () -> Format.fprintf ppf "Insufficient proof-of-work stamp")
    Data_encoding.empty
    (function Invalid_stamp -> Some () | _ -> None)
    (fun () -> Invalid_stamp) ;
  register_error_kind
    `Permanent
    ~id:"baking.unexpected_endorsement"
    ~title:"Endorsement from unexpected delegate"
    ~description:
      "The operation is signed by a delegate without endorsement rights."
    ~pp:(fun ppf () ->
      Format.fprintf
        ppf
        "The endorsement is signed by a delegate without endorsement rights.")
    Data_encoding.unit
    (function Unexpected_endorsement -> Some () | _ -> None)
    (fun () -> Unexpected_endorsement)

let minimal_time c priority pred_timestamp =
  let priority = Int32.of_int priority in
  let rec cumsum_time_between_blocks acc durations p =
    if Compare.Int32.( <= ) p 0l then ok acc
    else
      match durations with
      | [] ->
          cumsum_time_between_blocks acc [Period.one_minute] p
      | [last] ->
          Period.mult p last >>? fun period -> Timestamp.(acc +? period)
      | first :: durations ->
          Timestamp.(acc +? first)
          >>? fun acc ->
          let p = Int32.pred p in
          cumsum_time_between_blocks acc durations p
  in
  Lwt.return
    (cumsum_time_between_blocks
       pred_timestamp
       (Constants.time_between_blocks c)
       (Int32.succ priority))

let earlier_predecessor_timestamp ctxt level =
  let current = Level.current ctxt in
  let current_timestamp = Timestamp.current ctxt in
  let gap = Level.diff level current in
  let step = List.hd (Constants.time_between_blocks ctxt) in
  if Compare.Int32.(gap < 1l) then
    failwith "Baking.earlier_block_timestamp: past block."
  else
    Lwt.return (Period.mult (Int32.pred gap) step)
    >>=? fun delay ->
    Lwt.return Timestamp.(current_timestamp +? delay)
    >>=? fun result -> return result

let check_timestamp c priority pred_timestamp =
  minimal_time c priority pred_timestamp
  >>=? fun minimal_time ->
  let timestamp = Alpha_context.Timestamp.current c in
  Lwt.return
    (record_trace
       (Timestamp_too_early (minimal_time, timestamp))
       Timestamp.(timestamp -? minimal_time))

let check_baking_rights c {Block_header.priority; _} pred_timestamp =
  let level = Level.current c in
  Roll.baking_rights_owner c level ~priority
  >>=? fun delegate ->
  check_timestamp c priority pred_timestamp
  >>=? fun block_delay -> return (delegate, block_delay)

type error += Incorrect_priority (* `Permanent *)

type error += Incorrect_number_of_endorsements (* `Permanent *)

let () =
  register_error_kind
    `Permanent
    ~id:"incorrect_priority"
    ~title:"Incorrect priority"
    ~description:"Block priority must be non-negative."
    ~pp:(fun ppf () ->
      Format.fprintf ppf "The block priority must be non-negative.")
    Data_encoding.unit
    (function Incorrect_priority -> Some () | _ -> None)
    (fun () -> Incorrect_priority)

let () =
  let description =
    "The number of endorsements must be non-negative and at most the \
     endosers_per_block constant."
  in
  register_error_kind
    `Permanent
    ~id:"incorrect_number_of_endorsements"
    ~title:"Incorrect number of endorsements"
    ~description
    ~pp:(fun ppf () -> Format.fprintf ppf "%s" description)
    Data_encoding.unit
    (function Incorrect_number_of_endorsements -> Some () | _ -> None)
    (fun () -> Incorrect_number_of_endorsements)

let baking_reward ctxt ~block_priority:prio ~included_endorsements:num_endo =
  fail_unless Compare.Int.(prio >= 0) Incorrect_priority
  >>=? fun () ->
  let max_endorsements = Constants.endorsers_per_block ctxt in
  fail_unless
    Compare.Int.(num_endo >= 0 && num_endo <= max_endorsements)
    Incorrect_number_of_endorsements
  >>=? fun () ->
  let prio_factor_denominator = Int64.(succ (of_int prio)) in
  let endo_factor_numerator =
    Int64.of_int (8 + (2 * num_endo / max_endorsements))
  in
  let endo_factor_denominator = 10L in
  Lwt.return
    Tez.(
      Constants.block_reward ctxt *? endo_factor_numerator
      >>? fun val1 ->
      val1 /? endo_factor_denominator
      >>? fun val2 -> val2 /? prio_factor_denominator)

let endorsing_reward ctxt ~block_priority:prio n =
  if Compare.Int.(prio >= 0) then
    Lwt.return
      Tez.(Constants.endorsement_reward ctxt /? Int64.(succ (of_int prio)))
    >>=? fun tez -> Lwt.return Tez.(tez *? Int64.of_int n)
  else fail Incorrect_priority

let baking_priorities c level =
  let rec f priority =
    Roll.baking_rights_owner c level ~priority
    >>=? fun delegate -> return (LCons (delegate, fun () -> f (succ priority)))
  in
  f 0

let endorsement_rights c level =
  fold_left_s
    (fun acc slot ->
      Roll.endorsement_rights_owner c level ~slot
      >>=? fun pk ->
      let pkh = Signature.Public_key.hash pk in
      let right =
        match Signature.Public_key_hash.Map.find_opt pkh acc with
        | None ->
            (pk, [slot], false)
        | Some (pk, slots, used) ->
            (pk, slot :: slots, used)
      in
      return (Signature.Public_key_hash.Map.add pkh right acc))
    Signature.Public_key_hash.Map.empty
    (0 --> (Constants.endorsers_per_block c - 1))

let check_endorsement_rights ctxt chain_id (op : Kind.endorsement Operation.t)
    =
  let current_level = Level.current ctxt in
  let (Single (Endorsement {level; _})) = op.protocol_data.contents in
  ( if Raw_level.(succ level = current_level.level) then
    return (Alpha_context.allowed_endorsements ctxt)
  else endorsement_rights ctxt (Level.from_raw ctxt level) )
  >>=? fun endorsements ->
  match
    Signature.Public_key_hash.Map.fold (* no find_first *)
      (fun pkh (pk, slots, used) acc ->
        match Operation.check_signature_sync pk chain_id op with
        | Error _ ->
            acc
        | Ok () ->
            Some (pkh, slots, used))
      endorsements
      None
  with
  | None ->
      fail Unexpected_endorsement
  | Some v ->
      return v

let select_delegate delegate delegate_list max_priority =
  let rec loop acc l n =
    if Compare.Int.(n >= max_priority) then return (List.rev acc)
    else
      let (LCons (pk, t)) = l in
      let acc =
        if
          Signature.Public_key_hash.equal
            delegate
            (Signature.Public_key.hash pk)
        then n :: acc
        else acc
      in
      t () >>=? fun t -> loop acc t (succ n)
  in
  loop [] delegate_list 0

let first_baking_priorities ctxt ?(max_priority = 32) delegate level =
  baking_priorities ctxt level
  >>=? fun delegate_list -> select_delegate delegate delegate_list max_priority

let check_hash hash stamp_threshold =
  let bytes = Block_hash.to_bytes hash in
  let word = MBytes.get_int64 bytes 0 in
  Compare.Uint64.(word <= stamp_threshold)

let check_header_proof_of_work_stamp shell contents stamp_threshold =
  let hash =
    Block_header.hash
      {shell; protocol_data = {contents; signature = Signature.zero}}
  in
  check_hash hash stamp_threshold

let check_proof_of_work_stamp ctxt block =
  let proof_of_work_threshold = Constants.proof_of_work_threshold ctxt in
  if
    check_header_proof_of_work_stamp
      block.Block_header.shell
      block.protocol_data.contents
      proof_of_work_threshold
  then return_unit
  else fail Invalid_stamp

let check_signature block chain_id key =
  let check_signature key
      {Block_header.shell; protocol_data = {contents; signature}} =
    let unsigned_header =
      Data_encoding.Binary.to_bytes_exn
        Block_header.unsigned_encoding
        (shell, contents)
    in
    Signature.check
      ~watermark:(Block_header chain_id)
      key
      signature
      unsigned_header
  in
  if check_signature key block then return_unit
  else
    fail
      (Invalid_block_signature
         (Block_header.hash block, Signature.Public_key.hash key))

let max_fitness_gap _ctxt = 1L

let check_fitness_gap ctxt (block : Block_header.t) =
  let current_fitness = Fitness.current ctxt in
  Lwt.return (Fitness.to_int64 block.shell.fitness)
  >>=? fun announced_fitness ->
  let gap = Int64.sub announced_fitness current_fitness in
  if Compare.Int64.(gap <= 0L || max_fitness_gap ctxt < gap) then
    fail (Invalid_fitness_gap (max_fitness_gap ctxt, gap))
  else return_unit

let last_of_a_cycle ctxt l =
  Compare.Int32.(
    Int32.succ l.Level.cycle_position = Constants.blocks_per_cycle ctxt)

let dawn_of_a_new_cycle ctxt =
  let level = Level.current ctxt in
  if last_of_a_cycle ctxt level then return_some level.cycle else return_none

let minimum_allowed_endorsements ctxt ~block_delay =
  let minimum = Constants.initial_endorsers ctxt in
  let delay_per_missing_endorsement =
    Int64.to_int
      (Period.to_seconds (Constants.delay_per_missing_endorsement ctxt))
  in
  let reduced_time_constraint =
    let delay = Int64.to_int (Period.to_seconds block_delay) in
    if Compare.Int.(delay_per_missing_endorsement = 0) then delay
    else delay / delay_per_missing_endorsement
  in
  Compare.Int.max 0 (minimum - reduced_time_constraint)

let minimal_valid_time ctxt ~priority ~endorsing_power =
  let predecessor_timestamp = Timestamp.current ctxt in
  minimal_time ctxt priority predecessor_timestamp
  >>=? fun minimal_time ->
  let minimal_required_endorsements = Constants.initial_endorsers ctxt in
  let delay_per_missing_endorsement =
    Constants.delay_per_missing_endorsement ctxt
  in
  let missing_endorsements =
    Compare.Int.max 0 (minimal_required_endorsements - endorsing_power)
  in
  match
    Period.mult
      (Int32.of_int missing_endorsements)
      delay_per_missing_endorsement
  with
  | Ok delay ->
      return (Time.add minimal_time (Period.to_seconds delay))
  | Error _ as err ->
      Lwt.return err

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Import Alpha_context.

Import Misc.

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Top-level evaluations are considered as an error as sources of side-effects *)
Compute
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "baking.timestamp_too_early" % string
      "Block forged too early" % string
      "The block timestamp is before the first slot for this baker at this level"
        % string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let '(r, p) := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Block forged too early (" % string
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                      " is before " % string
                      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Char_literal
                          ")" % char
                          Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))))
                "Block forged too early (%a is before %a)" % string) Time.pp_hum
              p Time.pp_hum r))
      (obj2 (req None None "minimum" % string Time.encoding)
        (req None None "provided" % string Time.encoding))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Timestamp_too_early
            r p => Some (r, p)
        | _ => None
        end)
      (fun function_parameter =>
        let '(r, p) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Timestamp_too_early
          r p) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "baking.invalid_fitness_gap" % string
      "Invalid fitness gap" % string
      "The gap of fitness is out of bounds" % string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let '(m, g) := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "The gap of fitness " % string
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int64
                    Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int_d
                    Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
                    Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_precision
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                      " is not between 0 and " % string
                      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int64
                        Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int_d
                        Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
                        Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_precision
                        Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format))))
                "The gap of fitness %Ld is not between 0 and %Ld" % string) g m))
      (obj2 (req None None "maximum" % string __int64_value)
        (req None None "provided" % string __int64_value))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_fitness_gap
            m g => Some (m, g)
        | _ => None
        end)
      (fun function_parameter =>
        let '(m, g) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_fitness_gap
          m g) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "baking.invalid_block_signature" % string
      "Invalid block signature" % string
      "A block was not signed with the expected private key." % string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let '(block, pkh) := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Invalid signature for block " % string
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                      ". Expected: " % string
                      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Char_literal
                          "." % char
                          Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))))
                "Invalid signature for block %a. Expected: %a." % string)
              Block_hash.pp_short block Signature.Public_key_hash.pp_short pkh))
      (obj2 (req None None "block" % string Block_hash.encoding)
        (req None None "expected" % string Signature.Public_key_hash.encoding))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_block_signature
            block pkh => Some (block, pkh)
        | _ => None
        end)
      (fun function_parameter =>
        let '(block, pkh) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_block_signature
          block pkh) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "baking.invalid_signature" % string
      "Invalid block signature" % string
      "The block's signature is invalid" % string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let 'tt := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Invalid block signature" % string
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
                "Invalid block signature" % string))) Data_encoding.empty
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_signature
          => Some tt
        | _ => None
        end)
      (fun function_parameter =>
        let 'tt := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_signature)
    in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "baking.insufficient_proof_of_work" % string
      "Insufficient block proof-of-work stamp" % string
      "The block's proof-of-work stamp is insufficient" % string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let 'tt := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Insufficient proof-of-work stamp" % string
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
                "Insufficient proof-of-work stamp" % string)))
      Data_encoding.empty
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_stamp
          => Some tt
        | _ => None
        end)
      (fun function_parameter =>
        let 'tt := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_stamp)
    in
  register_error_kind
    (* ❌ Variants not supported *)
    variant "baking.unexpected_endorsement" % string
    "Endorsement from unexpected delegate" % string
    "The operation is signed by a delegate without endorsement rights." % string
    (Some
      (fun ppf =>
        fun function_parameter =>
          let 'tt := function_parameter in
          Format.fprintf ppf
            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                "The endorsement is signed by a delegate without endorsement rights."
                  % string
                Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
              "The endorsement is signed by a delegate without endorsement rights."
                % string))) Data_encoding.__unit_value
    (fun function_parameter =>
      match function_parameter with
      |
        Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_endorsement
        => Some tt
      | _ => None
      end)
    (fun function_parameter =>
      let 'tt := function_parameter in
      Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_endorsement).

Definition minimal_time
  (c : Tezos_raw_protocol_alpha__Alpha_context.context) (priority : Z)
  (pred_timestamp : Tezos_raw_protocol_alpha.Alpha_context.Timestamp.time)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Alpha_context.Timestamp.time) :=
  let priority := Int32.of_int priority in
  let fix cumsum_time_between_blocks
    (acc : Tezos_raw_protocol_alpha.Alpha_context.Timestamp.time) (durations :
    list Tezos_raw_protocol_alpha.Alpha_context.Period.period) (p :
    Tezos_protocol_environment_alpha__Environment.Compare.Int32.t)
    : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Alpha_context.Timestamp.time :=
    if
      Compare.Int32.op_lteq p
        (* ❌ Constant of type int32 is converted to int *)
        0 then
      ok acc
    else
      match durations with
      | [] => cumsum_time_between_blocks acc (cons Period.one_minute []) p
      | cons last [] =>
        op_gtgtquestion (Period.mult p last)
          (fun period => op_plusquestion acc period)
      | cons first durations =>
        op_gtgtquestion (op_plusquestion acc first)
          (fun acc =>
            let p := Int32.pred p in
            cumsum_time_between_blocks acc durations p)
      end in
  Lwt.__return
    (cumsum_time_between_blocks pred_timestamp (Constants.time_between_blocks c)
      (Int32.succ priority)).

Definition earlier_predecessor_timestamp
  (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
  (level : Tezos_raw_protocol_alpha.Alpha_context.Level.level)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Alpha_context.Timestamp.time) :=
  let current := Level.current ctxt in
  let current_timestamp := Timestamp.current ctxt in
  let gap := Level.diff level current in
  let step := List.hd (Constants.time_between_blocks ctxt) in
  if
    op_lt gap
      (* ❌ Constant of type int32 is converted to int *)
      1 then
    failwith "Baking.earlier_block_timestamp: past block." % string
  else
    op_gtgteqquestion (Lwt.__return (Period.mult (Int32.pred gap) step))
      (fun delay =>
        op_gtgteqquestion
          (Lwt.__return (op_plusquestion current_timestamp delay))
          (fun __result_value => __return __result_value)).

Definition check_timestamp
  (c : Tezos_raw_protocol_alpha__Alpha_context.context) (priority : Z)
  (pred_timestamp : Tezos_raw_protocol_alpha.Alpha_context.Timestamp.time)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha__Alpha_context.Period.t) :=
  op_gtgteqquestion (minimal_time c priority pred_timestamp)
    (fun minimal_time =>
      let timestamp := Alpha_context.Timestamp.current c in
      Lwt.__return
        (record_trace
          (Tezos_protocol_environment_alpha__Environment.Error_monad.Timestamp_too_early
            minimal_time timestamp) (op_minusquestion timestamp minimal_time))).

Definition check_baking_rights
  (c : Tezos_raw_protocol_alpha__Alpha_context.context)
  (function_parameter :
    Tezos_raw_protocol_alpha.Alpha_context.Block_header.contents)
  : Tezos_raw_protocol_alpha.Alpha_context.Timestamp.time ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha__Alpha_context.public_key *
        Tezos_raw_protocol_alpha__Alpha_context.Period.t)) :=
  let '{|
    Tezos_raw_protocol_alpha.Alpha_context.Block_header.contents.priority :=
      priority
      |} := function_parameter in
  fun pred_timestamp =>
    let level := Level.current c in
    op_gtgteqquestion (Roll.baking_rights_owner c level priority)
      (fun delegate =>
        op_gtgteqquestion (check_timestamp c priority pred_timestamp)
          (fun block_delay => __return (delegate, block_delay))).

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Top-level evaluations are considered as an error as sources of side-effects *)
Compute
  register_error_kind
    (* ❌ Variants not supported *)
    variant "incorrect_priority" % string "Incorrect priority" % string
    "Block priority must be non-negative." % string
    (Some
      (fun ppf =>
        fun function_parameter =>
          let 'tt := function_parameter in
          Format.fprintf ppf
            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                "The block priority must be non-negative." % string
                Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
              "The block priority must be non-negative." % string)))
    Data_encoding.__unit_value
    (fun function_parameter =>
      match function_parameter with
      |
        Tezos_protocol_environment_alpha__Environment.Error_monad.Incorrect_priority
        => Some tt
      | _ => None
      end)
    (fun function_parameter =>
      let 'tt := function_parameter in
      Tezos_protocol_environment_alpha__Environment.Error_monad.Incorrect_priority).

(* ❌ Top-level evaluations are considered as an error as sources of side-effects *)
Compute
  let description :=
    "The number of endorsements must be non-negative and at most the endosers_per_block constant."
      % string in
  register_error_kind
    (* ❌ Variants not supported *)
    variant "incorrect_number_of_endorsements" % string
    "Incorrect number of endorsements" % string description
    (Some
      (fun ppf =>
        fun function_parameter =>
          let 'tt := function_parameter in
          Format.fprintf ppf
            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String
                Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
                Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
              "%s" % string) description)) Data_encoding.__unit_value
    (fun function_parameter =>
      match function_parameter with
      |
        Tezos_protocol_environment_alpha__Environment.Error_monad.Incorrect_number_of_endorsements
        => Some tt
      | _ => None
      end)
    (fun function_parameter =>
      let 'tt := function_parameter in
      Tezos_protocol_environment_alpha__Environment.Error_monad.Incorrect_number_of_endorsements).

Definition baking_reward
  (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
  (prio : Tezos_protocol_environment_alpha__Environment.Compare.Int.t)
  (num_endo : Tezos_protocol_environment_alpha__Environment.Compare.Int.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Alpha_context.Tez.tez) :=
  op_gtgteqquestion
    (fail_unless (op_gteq prio 0)
      Tezos_protocol_environment_alpha__Environment.Error_monad.Incorrect_priority)
    (fun function_parameter =>
      let 'tt := function_parameter in
      let max_endorsements := Constants.endorsers_per_block ctxt in
      op_gtgteqquestion
        (fail_unless
          (op_andand (op_gteq num_endo 0) (op_lteq num_endo max_endorsements))
          Tezos_protocol_environment_alpha__Environment.Error_monad.Incorrect_number_of_endorsements)
        (fun function_parameter =>
          let 'tt := function_parameter in
          let prio_factor_denominator := succ (of_int prio) in
          let endo_factor_numerator :=
            Int64.of_int
              (op_plus 8 (op_div (op_star 2 num_endo) max_endorsements)) in
          let endo_factor_denominator :=
            (* ❌ Constant of type int64 is converted to int *)
            10 in
          Lwt.__return
            (op_gtgtquestion
              (op_starquestion (Constants.block_reward ctxt)
                endo_factor_numerator)
              (fun val1 =>
                op_gtgtquestion (op_divquestion val1 endo_factor_denominator)
                  (fun val2 => op_divquestion val2 prio_factor_denominator))))).

Definition endorsing_reward
  (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
  (prio : Tezos_protocol_environment_alpha__Environment.Compare.Int.t) (n : Z)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Alpha_context.Tez.tez) :=
  if op_gteq prio 0 then
    op_gtgteqquestion
      (Lwt.__return
        (op_divquestion (Constants.endorsement_reward ctxt) (succ (of_int prio))))
      (fun tez => Lwt.__return (op_starquestion tez (Int64.of_int n)))
  else
    fail
      Tezos_protocol_environment_alpha__Environment.Error_monad.Incorrect_priority.

Definition baking_priorities
  (c : Tezos_raw_protocol_alpha__Alpha_context.context)
  (level : Tezos_raw_protocol_alpha__Alpha_context.Level.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Misc.lazy_list_t
        Tezos_raw_protocol_alpha__Alpha_context.public_key)) :=
  let fix f (priority : Z)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (Tezos_raw_protocol_alpha.Misc.lazy_list_t
          Tezos_raw_protocol_alpha__Alpha_context.public_key)) :=
    op_gtgteqquestion (Roll.baking_rights_owner c level priority)
      (fun delegate =>
        __return
          (Tezos_raw_protocol_alpha.Misc.LCons delegate
            (fun function_parameter =>
              let 'tt := function_parameter in
              f (succ priority)))) in
  f 0.

Definition endorsement_rights
  (c : Tezos_raw_protocol_alpha__Alpha_context.context)
  (level : Tezos_raw_protocol_alpha__Alpha_context.Level.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.Map.t
        (Tezos_raw_protocol_alpha__Alpha_context.public_key * list Z * bool))) :=
  fold_left_s
    (fun acc =>
      fun slot =>
        op_gtgteqquestion (Roll.endorsement_rights_owner c level slot)
          (fun pk =>
            let pkh := Signature.Public_key.__hash_value pk in
            let right :=
              match Signature.Public_key_hash.Map.find_opt pkh acc with
              | None => (pk, (cons slot []), false)
              | Some (pk, slots, used) => (pk, (cons slot slots), used)
              end in
            __return (Signature.Public_key_hash.Map.add pkh right acc)))
    Signature.Public_key_hash.Map.empty
    (op_minusminusgt 0 (op_minus (Constants.endorsers_per_block c) 1)).

Definition check_endorsement_rights
  (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
  (chain_id : Tezos_protocol_environment_alpha__Environment.Chain_id.t)
  (op :
    Tezos_raw_protocol_alpha.Alpha_context.Operation.t
      Tezos_raw_protocol_alpha.Alpha_context.Kind.endorsement)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.Map.key
        * list Z * bool)) :=
  let current_level := Level.current ctxt in
  let
    'Tezos_raw_protocol_alpha.Alpha_context.Single
      (Tezos_raw_protocol_alpha.Alpha_context.Endorsement {|
        Tezos_raw_protocol_alpha.Alpha_context.contents.Endorsement.level := level
          |}) :=
    Tezos_raw_protocol_alpha.Alpha_context.protocol_data.contents
      (Tezos_raw_protocol_alpha.Alpha_context.operation.protocol_data op) in
  op_gtgteqquestion
    (if
      op_eq (succ level)
        (Tezos_raw_protocol_alpha.Alpha_context.Level.t.level current_level)
      then
      __return (Alpha_context.allowed_endorsements ctxt)
    else
      endorsement_rights ctxt (Level.from_raw ctxt None level))
    (fun endorsements =>
      match
        Signature.Public_key_hash.Map.fold
          (fun pkh =>
            fun function_parameter =>
              let '(pk, slots, used) := function_parameter in
              fun acc =>
                match Operation.check_signature_sync pk chain_id op with
                |
                  Tezos_protocol_environment_alpha__Environment.Pervasives.Error
                    _ => acc
                | Tezos_protocol_environment_alpha__Environment.Pervasives.Ok tt
                  => Some (pkh, slots, used)
                end) endorsements None with
      | None =>
        fail
          Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_endorsement
      | Some v => __return v
      end).

Definition select_delegate
  (delegate :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  (delegate_list :
    Tezos_raw_protocol_alpha.Misc.lazy_list_t
      Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t)
  (max_priority : Tezos_protocol_environment_alpha__Environment.Compare.Int.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (list Tezos_protocol_environment_alpha__Environment.Compare.Int.t)) :=
  let fix loop
    (acc : list Tezos_protocol_environment_alpha__Environment.Compare.Int.t) (l
    :
    Tezos_raw_protocol_alpha.Misc.lazy_list_t
      Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t) (n :
    Tezos_protocol_environment_alpha__Environment.Compare.Int.t)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (list Tezos_protocol_environment_alpha__Environment.Compare.Int.t)) :=
    if op_gteq n max_priority then
      __return (List.rev acc)
    else
      let 'Tezos_raw_protocol_alpha.Misc.LCons pk t := l in
      let acc :=
        if
          Signature.Public_key_hash.equal delegate
            (Signature.Public_key.__hash_value pk) then
          cons n acc
        else
          acc in
      op_gtgteqquestion (t tt) (fun t => loop acc t (succ n)) in
  loop [] delegate_list 0.

Definition first_baking_priorities
  (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
  (op_staroptstar :
    option Tezos_protocol_environment_alpha__Environment.Compare.Int.t)
  : Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Tezos_raw_protocol_alpha__Alpha_context.Level.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (list Tezos_protocol_environment_alpha__Environment.Compare.Int.t)) :=
  let max_priority :=
    match op_staroptstar with
    | Some op_starsthstar => op_starsthstar
    | None => 32
    end in
  fun delegate =>
    fun level =>
      op_gtgteqquestion (baking_priorities ctxt level)
        (fun delegate_list =>
          select_delegate delegate delegate_list max_priority).

Definition check_hash
  (__hash_value : Tezos_protocol_environment_alpha__Environment.Block_hash.t)
  (stamp_threshold :
    Tezos_protocol_environment_alpha__Environment.Compare.Uint64.t) : bool :=
  let __bytes_value := Block_hash.to_bytes __hash_value in
  let word := MBytes.get_int64 __bytes_value 0 in
  op_lteq word stamp_threshold.

Definition check_header_proof_of_work_stamp
  (shell :
    Tezos_protocol_environment_alpha__Environment.Block_header.shell_header)
  (contents : Tezos_raw_protocol_alpha.Alpha_context.Block_header.contents)
  (stamp_threshold :
    Tezos_protocol_environment_alpha__Environment.Compare.Uint64.t) : bool :=
  let __hash_value :=
    Block_header.__hash_value
      {| Tezos_raw_protocol_alpha.Alpha_context.Block_header.t.shell := shell;
        Tezos_raw_protocol_alpha.Alpha_context.Block_header.t.protocol_data :=
          {|
            Tezos_raw_protocol_alpha.Alpha_context.Block_header.protocol_data.contents :=
              contents;
            Tezos_raw_protocol_alpha.Alpha_context.Block_header.protocol_data.signature :=
              Signature.zero |} |} in
  check_hash __hash_value stamp_threshold.

Definition check_proof_of_work_stamp
  (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
  (block : Tezos_raw_protocol_alpha.Alpha_context.Block_header.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
  let proof_of_work_threshold := Constants.proof_of_work_threshold ctxt in
  if
    check_header_proof_of_work_stamp
      (Tezos_raw_protocol_alpha.Alpha_context.Block_header.t.shell block)
      (Tezos_raw_protocol_alpha.Alpha_context.Block_header.protocol_data.contents
        (Tezos_raw_protocol_alpha.Alpha_context.Block_header.t.protocol_data
          block)) proof_of_work_threshold then
    return_unit
  else
    fail Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_stamp.

Definition check_signature
  (block : Tezos_raw_protocol_alpha.Alpha_context.Block_header.t)
  (chain_id : Tezos_protocol_environment_alpha__Environment.Chain_id.t)
  (key : Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
  let check_signature
    (key : Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t)
    (function_parameter : Tezos_raw_protocol_alpha.Alpha_context.Block_header.t)
    : bool :=
    let '{|
      Tezos_raw_protocol_alpha.Alpha_context.Block_header.t.shell := shell;
        Tezos_raw_protocol_alpha.Alpha_context.Block_header.t.protocol_data :=
          {|
          Tezos_raw_protocol_alpha.Alpha_context.Block_header.protocol_data.contents
            := contents;
            Tezos_raw_protocol_alpha.Alpha_context.Block_header.protocol_data.signature
              := signature
            |}
        |} := function_parameter in
    let unsigned_header :=
      Data_encoding.Binary.to_bytes_exn Block_header.unsigned_encoding
        (shell, contents) in
    Signature.check
      (Some
        (Tezos_protocol_environment_alpha__Environment.Signature.Block_header
          chain_id)) key signature unsigned_header in
  if check_signature key block then
    return_unit
  else
    fail
      (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_block_signature
        (Block_header.__hash_value block)
        (Signature.Public_key.__hash_value key)).

Definition max_fitness_gap {A : Set} (_ctxt : A) : int64 :=
  (* ❌ Constant of type int64 is converted to int *)
  1.

Definition check_fitness_gap
  (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
  (block : Tezos_raw_protocol_alpha.Alpha_context.Block_header.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
  let current_fitness := Fitness.current ctxt in
  op_gtgteqquestion
    (Lwt.__return
      (Fitness.to_int64
        (Tezos_protocol_environment_alpha__Environment.Block_header.shell_header.fitness
          (Tezos_raw_protocol_alpha.Alpha_context.Block_header.t.shell block))))
    (fun announced_fitness =>
      let gap := Int64.sub announced_fitness current_fitness in
      if
        op_pipepipe
          (op_lteq gap
            (* ❌ Constant of type int64 is converted to int *)
            0) (op_lt (max_fitness_gap ctxt) gap) then
        fail
          (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_fitness_gap
            (max_fitness_gap ctxt) gap)
      else
        return_unit).

Definition last_of_a_cycle
  (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
  (l : Tezos_raw_protocol_alpha.Alpha_context.Level.t) : bool :=
  op_eq
    (Int32.succ
      (Tezos_raw_protocol_alpha.Alpha_context.Level.t.cycle_position l))
    (Constants.blocks_per_cycle ctxt).

Definition dawn_of_a_new_cycle
  (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (option Tezos_raw_protocol_alpha__Alpha_context.Cycle.t)) :=
  let level := Level.current ctxt in
  if last_of_a_cycle ctxt level then
    return_some (Tezos_raw_protocol_alpha.Alpha_context.Level.t.cycle level)
  else
    return_none.

Definition minimum_allowed_endorsements
  (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
  (block_delay : Tezos_raw_protocol_alpha.Alpha_context.Period.period)
  : Tezos_protocol_environment_alpha__Environment.Compare.Int.t :=
  let minimum := Constants.initial_endorsers ctxt in
  let delay_per_missing_endorsement :=
    Int64.to_int
      (Period.to_seconds (Constants.delay_per_missing_endorsement ctxt)) in
  let reduced_time_constraint :=
    let delay := Int64.to_int (Period.to_seconds block_delay) in
    if op_eq delay_per_missing_endorsement 0 then
      delay
    else
      op_div delay delay_per_missing_endorsement in
  Compare.Int.max 0 (op_minus minimum reduced_time_constraint).

Definition minimal_valid_time
  (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context) (priority : Z)
  (endorsing_power : Z)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_protocol_environment_alpha__Environment.Time.t) :=
  let predecessor_timestamp := Timestamp.current ctxt in
  op_gtgteqquestion (minimal_time ctxt priority predecessor_timestamp)
    (fun minimal_time =>
      let minimal_required_endorsements := Constants.initial_endorsers ctxt in
      let delay_per_missing_endorsement :=
        Constants.delay_per_missing_endorsement ctxt in
      let missing_endorsements :=
        Compare.Int.max 0
          (op_minus minimal_required_endorsements endorsing_power) in
      match
        Period.mult (Int32.of_int missing_endorsements)
          delay_per_missing_endorsement with
      | Tezos_protocol_environment_alpha__Environment.Pervasives.Ok delay =>
        __return (Time.add minimal_time (Period.to_seconds delay))
      |
        (Tezos_protocol_environment_alpha__Environment.Pervasives.Error _) as
          err => Lwt.__return err
      end).

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Alpha_context
open Misc

type error += Invalid_fitness_gap of int64 * int64 (* `Permanent *)

type error += Timestamp_too_early of Timestamp.t * Timestamp.t

(* `Permanent *)

type error +=
  | Invalid_block_signature of Block_hash.t * Signature.Public_key_hash.t

(* `Permanent *)

type error += Unexpected_endorsement

type error += Invalid_signature (* `Permanent *)

type error += Invalid_stamp (* `Permanent *)

(** [minimal_time ctxt priority pred_block_time] returns the minimal
    time, given the predecessor block timestamp [pred_block_time],
    after which a baker with priority [priority] is allowed to
    bake. Fail with [Invalid_time_between_blocks_constant] if the minimal
    time cannot be computed. *)
val minimal_time : context -> int -> Time.t -> Time.t tzresult Lwt.t

(** [check_baking_rights ctxt block pred_timestamp] verifies that:
    * the contract that owned the roll at cycle start has the block signer as delegate.
    * the timestamp is coherent with the announced slot.
*)
val check_baking_rights :
  context ->
  Block_header.contents ->
  Time.t ->
  (public_key * Period.t) tzresult Lwt.t

(** For a given level computes who has the right to
    include an endorsement in the next block.
    The result can be stored in Alpha_context.allowed_endorsements *)
val endorsement_rights :
  context ->
  Level.t ->
  (public_key * int list * bool) Signature.Public_key_hash.Map.t tzresult Lwt.t

(** Check that the operation was signed by a delegate allowed
    to endorse at the level specified by the endorsement. *)
val check_endorsement_rights :
  context ->
  Chain_id.t ->
  Kind.endorsement Operation.t ->
  (public_key_hash * int list * bool) tzresult Lwt.t

(** Returns the baking reward calculated w.r.t a given priority [p] and a
    number [e] of included endorsements as follows:
      (block_reward / (p+1)) * (0.8 + 0.2 * e / endorsers_per_block)
*)
val baking_reward :
  context ->
  block_priority:int ->
  included_endorsements:int ->
  Tez.t tzresult Lwt.t

(** Returns the endorsing reward calculated w.r.t a given priority.  *)
val endorsing_reward :
  context -> block_priority:int -> int -> Tez.t tzresult Lwt.t

(** [baking_priorities ctxt level] is the lazy list of contract's
    public key hashes that are allowed to bake for [level]. *)
val baking_priorities : context -> Level.t -> public_key lazy_list

(** [first_baking_priorities ctxt ?max_priority contract_hash level]
    is a list of priorities of max [?max_priority] elements, where the
    delegate of [contract_hash] is allowed to bake for [level]. If
    [?max_priority] is [None], a sensible number of priorities is
    returned. *)
val first_baking_priorities :
  context ->
  ?max_priority:int ->
  public_key_hash ->
  Level.t ->
  int list tzresult Lwt.t

(** [check_signature ctxt chain_id block id] check if the block is
    signed with the given key, and belongs to the given [chain_id] *)
val check_signature :
  Block_header.t -> Chain_id.t -> public_key -> unit tzresult Lwt.t

(** Checks if the header that would be built from the given components
    is valid for the given diffculty. The signature is not passed as it
    is does not impact the proof-of-work stamp. The stamp is checked on
    the hash of a block header whose signature has been zeroed-out. *)
val check_header_proof_of_work_stamp :
  Block_header.shell_header -> Block_header.contents -> int64 -> bool

(** verify if the proof of work stamp is valid *)
val check_proof_of_work_stamp :
  context -> Block_header.t -> unit tzresult Lwt.t

(** check if the gap between the fitness of the current context
    and the given block is within the protocol parameters *)
val check_fitness_gap : context -> Block_header.t -> unit tzresult Lwt.t

val dawn_of_a_new_cycle : context -> Cycle.t option tzresult Lwt.t

val earlier_predecessor_timestamp :
  context -> Level.t -> Timestamp.t tzresult Lwt.t

(** Since Emmy+

    A block is valid only if its timestamp has a minimal delay with
    respect to the previous block's timestamp, and this minimal delay
    depends not only on the block's priority but also on the number of
    endorsement operations included in the block.

    In Emmy+, blocks' fitness increases by one unit with each level.

    In this way, Emmy+ simplifies the optimal baking strategy: The
    bakers used to have to choose whether to wait for more endorsements
    to include in their block, or to publish the block immediately,
    without waiting. The incentive for including more endorsements was
    to increase the fitness and win against unknown blocks. However,
    when a block was produced too late in the priority period, there
    was the risk that the block did not reach endorsers before the
    block of next priority. In Emmy+, the baker does not need to take
    such a decision, because the baker cannot publish a block too
    early. *)

(** Given a delay of a block's timestamp with respect to the minimum
    time to bake at the block's priority (as returned by
    `minimum_time`), it returns the minimum number of endorsements that
    the block has to contain *)
val minimum_allowed_endorsements : context -> block_delay:Period.t -> int

(** This is the somehow the dual of the previous function. Given a
    block priority and a number of endorsement slots (given by the
    `endorsing_power` argument), it returns the minimum time at which
    the next block can be baked. *)
val minimal_valid_time :
  context -> priority:int -> endorsing_power:int -> Time.t tzresult Lwt.t

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

(* extensible_type Tezos_protocol_environment_alpha__Environment.Error_monad.error *)

(* extensible_type Tezos_protocol_environment_alpha__Environment.Error_monad.error *)

(* extensible_type Tezos_protocol_environment_alpha__Environment.Error_monad.error *)

(* extensible_type Tezos_protocol_environment_alpha__Environment.Error_monad.error *)

(* extensible_type Tezos_protocol_environment_alpha__Environment.Error_monad.error *)

(* extensible_type Tezos_protocol_environment_alpha__Environment.Error_monad.error *)

Parameter minimal_time :
  Tezos_raw_protocol_alpha.Alpha_context.context -> Z ->
  Tezos_protocol_environment_alpha__Environment.Time.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_protocol_environment_alpha__Environment.Time.t).

Parameter check_baking_rights :
  Tezos_raw_protocol_alpha.Alpha_context.context ->
  Tezos_raw_protocol_alpha.Alpha_context.Block_header.contents ->
  Tezos_protocol_environment_alpha__Environment.Time.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Alpha_context.public_key *
        Tezos_raw_protocol_alpha.Alpha_context.Period.t)).

Parameter endorsement_rights :
  Tezos_raw_protocol_alpha.Alpha_context.context ->
  Tezos_raw_protocol_alpha.Alpha_context.Level.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.Map.t
        (Tezos_raw_protocol_alpha.Alpha_context.public_key * list Z * bool))).

Parameter check_endorsement_rights :
  Tezos_raw_protocol_alpha.Alpha_context.context ->
  Tezos_protocol_environment_alpha__Environment.Chain_id.t ->
  Tezos_raw_protocol_alpha.Alpha_context.Operation.t
    Tezos_raw_protocol_alpha.Alpha_context.Kind.endorsement ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Alpha_context.public_key_hash * list Z * bool)).

Parameter baking_reward :
  Tezos_raw_protocol_alpha.Alpha_context.context -> Z -> Z ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Alpha_context.Tez.t).

Parameter endorsing_reward :
  Tezos_raw_protocol_alpha.Alpha_context.context -> Z -> Z ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Alpha_context.Tez.t).

Parameter baking_priorities :
  Tezos_raw_protocol_alpha.Alpha_context.context ->
  Tezos_raw_protocol_alpha.Alpha_context.Level.t ->
  Tezos_raw_protocol_alpha.Misc.lazy_list
    Tezos_raw_protocol_alpha.Alpha_context.public_key.

Parameter first_baking_priorities :
  Tezos_raw_protocol_alpha.Alpha_context.context -> option Z ->
  Tezos_raw_protocol_alpha.Alpha_context.public_key_hash ->
  Tezos_raw_protocol_alpha.Alpha_context.Level.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult (list Z)).

Parameter check_signature :
  Tezos_raw_protocol_alpha.Alpha_context.Block_header.t ->
  Tezos_protocol_environment_alpha__Environment.Chain_id.t ->
  Tezos_raw_protocol_alpha.Alpha_context.public_key ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit).

Parameter check_header_proof_of_work_stamp :
  Tezos_raw_protocol_alpha.Alpha_context.Block_header.shell_header ->
  Tezos_raw_protocol_alpha.Alpha_context.Block_header.contents -> int64 -> bool.

Parameter check_proof_of_work_stamp :
  Tezos_raw_protocol_alpha.Alpha_context.context ->
  Tezos_raw_protocol_alpha.Alpha_context.Block_header.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit).

Parameter check_fitness_gap :
  Tezos_raw_protocol_alpha.Alpha_context.context ->
  Tezos_raw_protocol_alpha.Alpha_context.Block_header.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit).

Parameter dawn_of_a_new_cycle :
  Tezos_raw_protocol_alpha.Alpha_context.context ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (option Tezos_raw_protocol_alpha.Alpha_context.Cycle.t)).

Parameter earlier_predecessor_timestamp :
  Tezos_raw_protocol_alpha.Alpha_context.context ->
  Tezos_raw_protocol_alpha.Alpha_context.Level.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Alpha_context.Timestamp.t).

Parameter minimum_allowed_endorsements :
  Tezos_raw_protocol_alpha.Alpha_context.context ->
  Tezos_raw_protocol_alpha.Alpha_context.Period.t -> Z.

Parameter minimal_valid_time :
  Tezos_raw_protocol_alpha.Alpha_context.context -> Z -> Z ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_protocol_environment_alpha__Environment.Time.t).

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

module H =
  Blake2B.Make
    (Base58)
    (struct
      let name = "Blinded public key hash"

      let title = "A blinded public key hash"

      let b58check_prefix = "\001\002\049\223"

      let size = Some Ed25519.Public_key_hash.size
    end)

include H

let () = Base58.check_encoded_prefix b58check_encoding "btz1" 37

let of_ed25519_pkh activation_code pkh =
  hash_bytes ~key:activation_code [Ed25519.Public_key_hash.to_bytes pkh]

type activation_code = MBytes.t

let activation_code_size = Ed25519.Public_key_hash.size

let activation_code_encoding = Data_encoding.Fixed.bytes activation_code_size

let activation_code_of_hex h =
  if Compare.Int.(String.length h <> activation_code_size * 2) then
    invalid_arg "Blinded_public_key_hash.activation_code_of_hex" ;
  MBytes.of_hex (`Hex h)

module Index = H

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

(* ❌ Applications of functors are not handled. *)
functor_application

Export H.

(* ❌ Top-level evaluations are considered as an error as sources of side-effects *)
Compute Base58.check_encoded_prefix b58check_encoding "btz1" % string 37.

Definition of_ed25519_pkh
  (activation_code : Tezos_protocol_environment_alpha__Environment.MBytes.t)
  (pkh : Tezos_protocol_environment_alpha__Environment.Ed25519.Public_key_hash.t)
  : t :=
  hash_bytes (Some activation_code)
    (cons (Ed25519.Public_key_hash.to_bytes pkh) []).

Definition activation_code :=
  Tezos_protocol_environment_alpha__Environment.MBytes.t.

Definition activation_code_size : Z := Ed25519.Public_key_hash.size.

Definition activation_code_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    Tezos_protocol_environment_alpha__Environment.MBytes.t :=
  Data_encoding.Fixed.__bytes_value activation_code_size.

Definition activation_code_of_hex (h : string)
  : Tezos_protocol_environment_alpha__Environment.MBytes.t :=
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    if op_ltgt (String.length h) (op_star activation_code_size 2) then
      invalid_arg "Blinded_public_key_hash.activation_code_of_hex" % string
    else
      tt in
  MBytes.of_hex
    (* ❌ Variants not supported *)
    variant.

Module Index := H.

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

include S.HASH

val encoding : t Data_encoding.t

val rpc_arg : t RPC_arg.t

type activation_code

val activation_code_encoding : activation_code Data_encoding.t

val of_ed25519_pkh : activation_code -> Ed25519.Public_key_hash.t -> t

val activation_code_of_hex : string -> activation_code

module Index : Storage_description.INDEX with type t = t

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Parameter t : Set.

Parameter name : string.

Parameter title : string.

Parameter pp :
  Tezos_protocol_environment_alpha__Environment.Format.formatter -> t -> unit.

Parameter pp_short :
  Tezos_protocol_environment_alpha__Environment.Format.formatter -> t -> unit.

Parameter op_eq : t -> t -> bool.

Parameter op_ltgt : t -> t -> bool.

Parameter op_lt : t -> t -> bool.

Parameter op_lteq : t -> t -> bool.

Parameter op_gteq : t -> t -> bool.

Parameter op_gt : t -> t -> bool.

Parameter compare : t -> t -> Z.

Parameter equal : t -> t -> bool.

Parameter max : t -> t -> t.

Parameter min : t -> t -> t.

Parameter hash_bytes :
  option Tezos_protocol_environment_alpha__Environment.MBytes.t ->
  list Tezos_protocol_environment_alpha__Environment.MBytes.t -> t.

Parameter hash_string : option string -> list string -> t.

Parameter zero : t.

Parameter size : Z.

Parameter to_bytes :
  t -> Tezos_protocol_environment_alpha__Environment.MBytes.t.

Parameter of_bytes_opt :
  Tezos_protocol_environment_alpha__Environment.MBytes.t -> option t.

Parameter of_bytes_exn :
  Tezos_protocol_environment_alpha__Environment.MBytes.t -> t.

Parameter to_b58check : t -> string.

Parameter to_short_b58check : t -> string.

Parameter of_b58check_exn : string -> t.

Parameter of_b58check_opt : string -> option t.

(* extensible_type Tezos_protocol_environment_alpha__Environment.Base58.data *)

Parameter b58check_encoding :
  Tezos_protocol_environment_alpha__Environment.Base58.encoding t.

Parameter encoding :
  Tezos_protocol_environment_alpha__Environment.Data_encoding.t t.

Parameter rpc_arg : Tezos_protocol_environment_alpha__Environment.RPC_arg.t t.

Parameter to_path : t -> list string -> list string.

Parameter of_path : list string -> option t.

Parameter of_path_exn : list string -> t.

Parameter prefix_path : string -> list string.

Parameter path_length : Z.

Module __Set.
  Definition elt := t.
  
  Parameter t : Set.
  
  Parameter empty : t.
  
  Parameter is_empty : t -> bool.
  
  Parameter mem : elt -> t -> bool.
  
  Parameter add : elt -> t -> t.
  
  Parameter singleton : elt -> t.
  
  Parameter remove : elt -> t -> t.
  
  Parameter union : t -> t -> t.
  
  Parameter inter : t -> t -> t.
  
  Parameter diff : t -> t -> t.
  
  Parameter compare : t -> t -> Z.
  
  Parameter equal : t -> t -> bool.
  
  Parameter subset : t -> t -> bool.
  
  Parameter iter : (elt -> unit) -> t -> unit.
  
  Parameter map : (elt -> elt) -> t -> t.
  
  Parameter fold : forall {a : Set}, (elt -> a -> a) -> t -> a -> a.
  
  Parameter for_all : (elt -> bool) -> t -> bool.
  
  Parameter __exists : (elt -> bool) -> t -> bool.
  
  Parameter filter : (elt -> bool) -> t -> t.
  
  Parameter partition : (elt -> bool) -> t -> t * t.
  
  Parameter cardinal : t -> Z.
  
  Parameter elements : t -> list elt.
  
  Parameter min_elt : t -> elt.
  
  Parameter min_elt_opt : t -> option elt.
  
  Parameter max_elt : t -> elt.
  
  Parameter max_elt_opt : t -> option elt.
  
  Parameter choose : t -> elt.
  
  Parameter choose_opt : t -> option elt.
  
  Parameter split : elt -> t -> t * bool * t.
  
  Parameter find : elt -> t -> elt.
  
  Parameter find_opt : elt -> t -> option elt.
  
  Parameter find_first : (elt -> bool) -> t -> elt.
  
  Parameter find_first_opt : (elt -> bool) -> t -> option elt.
  
  Parameter find_last : (elt -> bool) -> t -> elt.
  
  Parameter find_last_opt : (elt -> bool) -> t -> option elt.
  
  Parameter of_list : list elt -> t.
  
  Parameter to_seq_from : elt -> t -> OCaml.Seq.t elt.
  
  Parameter to_seq : t -> OCaml.Seq.t elt.
  
  Parameter add_seq : OCaml.Seq.t elt -> t -> t.
  
  Parameter of_seq : OCaml.Seq.t elt -> t.
  
  Parameter encoding :
    Tezos_protocol_environment_alpha__Environment.Data_encoding.t t.
End __Set.

Module Map.
  Definition key := t.
  
  Parameter t : forall (a : Set), Set.
  
  Parameter empty : forall {a : Set}, t a.
  
  Parameter is_empty : forall {a : Set}, t a -> bool.
  
  Parameter mem : forall {a : Set}, key -> t a -> bool.
  
  Parameter add : forall {a : Set}, key -> a -> t a -> t a.
  
  Parameter update : forall {a : Set},
    key -> (option a -> option a) -> t a -> t a.
  
  Parameter singleton : forall {a : Set}, key -> a -> t a.
  
  Parameter remove : forall {a : Set}, key -> t a -> t a.
  
  Parameter merge : forall {a b c : Set},
    (key -> option a -> option b -> option c) -> t a -> t b -> t c.
  
  Parameter union : forall {a : Set},
    (key -> a -> a -> option a) -> t a -> t a -> t a.
  
  Parameter compare : forall {a : Set}, (a -> a -> Z) -> t a -> t a -> Z.
  
  Parameter equal : forall {a : Set}, (a -> a -> bool) -> t a -> t a -> bool.
  
  Parameter iter : forall {a : Set}, (key -> a -> unit) -> t a -> unit.
  
  Parameter fold : forall {a b : Set}, (key -> a -> b -> b) -> t a -> b -> b.
  
  Parameter for_all : forall {a : Set}, (key -> a -> bool) -> t a -> bool.
  
  Parameter __exists : forall {a : Set}, (key -> a -> bool) -> t a -> bool.
  
  Parameter filter : forall {a : Set}, (key -> a -> bool) -> t a -> t a.
  
  Parameter partition : forall {a : Set},
    (key -> a -> bool) -> t a -> t a * t a.
  
  Parameter cardinal : forall {a : Set}, t a -> Z.
  
  Parameter bindings : forall {a : Set}, t a -> list (key * a).
  
  Parameter min_binding : forall {a : Set}, t a -> key * a.
  
  Parameter min_binding_opt : forall {a : Set}, t a -> option (key * a).
  
  Parameter max_binding : forall {a : Set}, t a -> key * a.
  
  Parameter max_binding_opt : forall {a : Set}, t a -> option (key * a).
  
  Parameter choose : forall {a : Set}, t a -> key * a.
  
  Parameter choose_opt : forall {a : Set}, t a -> option (key * a).
  
  Parameter split : forall {a : Set}, key -> t a -> t a * option a * t a.
  
  Parameter find : forall {a : Set}, key -> t a -> a.
  
  Parameter find_opt : forall {a : Set}, key -> t a -> option a.
  
  Parameter find_first : forall {a : Set}, (key -> bool) -> t a -> key * a.
  
  Parameter find_first_opt : forall {a : Set},
    (key -> bool) -> t a -> option (key * a).
  
  Parameter find_last : forall {a : Set}, (key -> bool) -> t a -> key * a.
  
  Parameter find_last_opt : forall {a : Set},
    (key -> bool) -> t a -> option (key * a).
  
  Parameter map : forall {a b : Set}, (a -> b) -> t a -> t b.
  
  Parameter mapi : forall {a b : Set}, (key -> a -> b) -> t a -> t b.
  
  Parameter to_seq : forall {a : Set}, t a -> OCaml.Seq.t (key * a).
  
  Parameter to_seq_from : forall {a : Set}, key -> t a -> OCaml.Seq.t (key * a).
  
  Parameter add_seq : forall {a : Set}, OCaml.Seq.t (key * a) -> t a -> t a.
  
  Parameter of_seq : forall {a : Set}, OCaml.Seq.t (key * a) -> t a.
  
  Parameter encoding : forall {a : Set},
    Tezos_protocol_environment_alpha__Environment.Data_encoding.t a ->
    Tezos_protocol_environment_alpha__Environment.Data_encoding.t (t a).
End Map.

Parameter encoding :
  Tezos_protocol_environment_alpha__Environment.Data_encoding.t t.

Parameter rpc_arg : Tezos_protocol_environment_alpha__Environment.RPC_arg.t t.

Parameter activation_code : Set.

Parameter activation_code_encoding :
  Tezos_protocol_environment_alpha__Environment.Data_encoding.t activation_code.

Parameter of_ed25519_pkh :
  activation_code ->
  Tezos_protocol_environment_alpha__Environment.Ed25519.Public_key_hash.t -> t.

Parameter activation_code_of_hex : string -> activation_code.

Module Index.
  Definition t := t.
  
  Parameter path_length : Z.
  
  Parameter to_path : t -> list string -> list string.
  
  Parameter of_path : list string -> option t.
  
  Parameter rpc_arg : Tezos_protocol_environment_alpha__Environment.RPC_arg.t t.
  
  Parameter encoding :
    Tezos_protocol_environment_alpha__Environment.Data_encoding.t t.
  
  Parameter compare : t -> t -> Z.
End Index.

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

(** Block header *)

type t = {shell : Block_header.shell_header; protocol_data : protocol_data}

and protocol_data = {contents : contents; signature : Signature.t}

and contents = {
  priority : int;
  seed_nonce_hash : Nonce_hash.t option;
  proof_of_work_nonce : MBytes.t;
}

type block_header = t

type raw = Block_header.t

type shell_header = Block_header.shell_header

let raw_encoding = Block_header.encoding

let shell_header_encoding = Block_header.shell_header_encoding

let contents_encoding =
  let open Data_encoding in
  def "block_header.alpha.unsigned_contents"
  @@ conv
       (fun {priority; seed_nonce_hash; proof_of_work_nonce} ->
         (priority, proof_of_work_nonce, seed_nonce_hash))
       (fun (priority, proof_of_work_nonce, seed_nonce_hash) ->
         {priority; seed_nonce_hash; proof_of_work_nonce})
       (obj3
          (req "priority" uint16)
          (req
             "proof_of_work_nonce"
             (Fixed.bytes Constants_repr.proof_of_work_nonce_size))
          (opt "seed_nonce_hash" Nonce_hash.encoding))

let protocol_data_encoding =
  let open Data_encoding in
  def "block_header.alpha.signed_contents"
  @@ conv
       (fun {contents; signature} -> (contents, signature))
       (fun (contents, signature) -> {contents; signature})
       (merge_objs
          contents_encoding
          (obj1 (req "signature" Signature.encoding)))

let raw {shell; protocol_data} =
  let protocol_data =
    Data_encoding.Binary.to_bytes_exn protocol_data_encoding protocol_data
  in
  {Block_header.shell; protocol_data}

let unsigned_encoding =
  let open Data_encoding in
  merge_objs Block_header.shell_header_encoding contents_encoding

let encoding =
  let open Data_encoding in
  def "block_header.alpha.full_header"
  @@ conv
       (fun {shell; protocol_data} -> (shell, protocol_data))
       (fun (shell, protocol_data) -> {shell; protocol_data})
       (merge_objs Block_header.shell_header_encoding protocol_data_encoding)

(** Constants *)

let max_header_length =
  let fake_shell =
    {
      Block_header.level = 0l;
      proto_level = 0;
      predecessor = Block_hash.zero;
      timestamp = Time.of_seconds 0L;
      validation_passes = 0;
      operations_hash = Operation_list_list_hash.zero;
      fitness = Fitness_repr.from_int64 0L;
      context = Context_hash.zero;
    }
  and fake_contents =
    {
      priority = 0;
      proof_of_work_nonce =
        MBytes.create Constants_repr.proof_of_work_nonce_size;
      seed_nonce_hash = Some Nonce_hash.zero;
    }
  in
  Data_encoding.Binary.length
    encoding
    {
      shell = fake_shell;
      protocol_data = {contents = fake_contents; signature = Signature.zero};
    }

(** Header parsing entry point  *)

let hash_raw = Block_header.hash

let hash {shell; protocol_data} =
  Block_header.hash
    {
      shell;
      protocol_data =
        Data_encoding.Binary.to_bytes_exn protocol_data_encoding protocol_data;
    }

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Reserved Notation "'t".
Reserved Notation "'protocol_data".
Reserved Notation "'contents".

Module contents_skeleton.
  Record record {priority seed_nonce_hash proof_of_work_nonce : Set} := {
    priority : priority;
    seed_nonce_hash : seed_nonce_hash;
    proof_of_work_nonce : proof_of_work_nonce }.
  Arguments record : clear implicits.
End contents_skeleton.
Definition contents_skeleton := contents_skeleton.record.

Module protocol_data_skeleton.
  Record record {contents signature : Set} := {
    contents : contents;
    signature : signature }.
  Arguments record : clear implicits.
End protocol_data_skeleton.
Definition protocol_data_skeleton := protocol_data_skeleton.record.

Module t_skeleton.
  Record record {shell protocol_data : Set} := {
    shell : shell;
    protocol_data : protocol_data }.
  Arguments record : clear implicits.
End t_skeleton.
Definition t_skeleton := t_skeleton.record.



where "'t" :=
  (t_skeleton
    Tezos_protocol_environment_alpha__Environment.Block_header.shell_header
    'protocol_data)
and "'protocol_data" :=
  (protocol_data_skeleton 'contents
    Tezos_protocol_environment_alpha__Environment.Signature.t)
and "'contents" :=
  (contents_skeleton Z (option Tezos_raw_protocol_alpha.Nonce_hash.t)
    Tezos_protocol_environment_alpha__Environment.MBytes.t).

Definition t := 't.
Definition protocol_data := 'protocol_data.
Definition contents := 'contents.

Definition block_header := t.

Definition raw := Tezos_protocol_environment_alpha__Environment.Block_header.t.

Definition shell_header :=
  Tezos_protocol_environment_alpha__Environment.Block_header.shell_header.

Definition raw_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.t
    Tezos_protocol_environment_alpha__Environment.Block_header.t :=
  Block_header.encoding.

Definition shell_header_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.t
    Tezos_protocol_environment_alpha__Environment.Block_header.shell_header :=
  Block_header.shell_header_encoding.

Definition contents_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    contents :=
  op_atat
    (let arg := def "block_header.alpha.unsigned_contents" % string in
    fun eta => arg None None eta)
    (conv
      (fun function_parameter =>
        let '{|
          contents.priority := priority;
            contents.seed_nonce_hash := seed_nonce_hash;
            contents.proof_of_work_nonce := proof_of_work_nonce
            |} := function_parameter in
        (priority, proof_of_work_nonce, seed_nonce_hash))
      (fun function_parameter =>
        let '(priority, proof_of_work_nonce, seed_nonce_hash) :=
          function_parameter in
        {| contents.priority := priority;
          contents.seed_nonce_hash := seed_nonce_hash;
          contents.proof_of_work_nonce := proof_of_work_nonce |}) None
      (obj3 (req None None "priority" % string uint16)
        (req None None "proof_of_work_nonce" % string
          (Fixed.__bytes_value Constants_repr.proof_of_work_nonce_size))
        (opt None None "seed_nonce_hash" % string Nonce_hash.encoding))).

Definition protocol_data_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    protocol_data :=
  op_atat
    (let arg := def "block_header.alpha.signed_contents" % string in
    fun eta => arg None None eta)
    (conv
      (fun function_parameter =>
        let '{|
          protocol_data.contents := contents;
            protocol_data.signature := signature
            |} := function_parameter in
        (contents, signature))
      (fun function_parameter =>
        let '(contents, signature) := function_parameter in
        {| protocol_data.contents := contents;
          protocol_data.signature := signature |}) None
      (merge_objs contents_encoding
        (obj1 (req None None "signature" % string Signature.encoding)))).

Definition raw (function_parameter : t)
  : Tezos_protocol_environment_alpha__Environment.Block_header.t :=
  let '{| t.shell := shell; t.protocol_data := protocol_data |} :=
    function_parameter in
  let protocol_data :=
    Data_encoding.Binary.to_bytes_exn protocol_data_encoding protocol_data in
  {|
    Tezos_protocol_environment_alpha__Environment.Block_header.t.shell := shell;
    Tezos_protocol_environment_alpha__Environment.Block_header.t.protocol_data :=
      protocol_data |}.

Definition unsigned_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    (Tezos_protocol_environment_alpha__Environment.Block_header.shell_header *
      contents) :=
  merge_objs Block_header.shell_header_encoding contents_encoding.

Definition encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding t :=
  op_atat
    (let arg := def "block_header.alpha.full_header" % string in
    fun eta => arg None None eta)
    (conv
      (fun function_parameter =>
        let '{| t.shell := shell; t.protocol_data := protocol_data |} :=
          function_parameter in
        (shell, protocol_data))
      (fun function_parameter =>
        let '(shell, protocol_data) := function_parameter in
        {| t.shell := shell; t.protocol_data := protocol_data |}) None
      (merge_objs Block_header.shell_header_encoding protocol_data_encoding)).

Definition max_header_length : Z :=
  let fake_shell
    : Tezos_protocol_environment_alpha__Environment.Block_header.shell_header :=
    {|
      Tezos_protocol_environment_alpha__Environment.Block_header.shell_header.level :=
        (* ❌ Constant of type int32 is converted to int *)
        0;
      Tezos_protocol_environment_alpha__Environment.Block_header.shell_header.proto_level :=
        0;
      Tezos_protocol_environment_alpha__Environment.Block_header.shell_header.predecessor :=
        Block_hash.zero;
      Tezos_protocol_environment_alpha__Environment.Block_header.shell_header.timestamp :=
        Time.of_seconds
          (* ❌ Constant of type int64 is converted to int *)
          0;
      Tezos_protocol_environment_alpha__Environment.Block_header.shell_header.validation_passes :=
        0;
      Tezos_protocol_environment_alpha__Environment.Block_header.shell_header.operations_hash :=
        Operation_list_list_hash.zero;
      Tezos_protocol_environment_alpha__Environment.Block_header.shell_header.fitness :=
        Fitness_repr.from_int64
          (* ❌ Constant of type int64 is converted to int *)
          0;
      Tezos_protocol_environment_alpha__Environment.Block_header.shell_header.context :=
        Context_hash.zero |}
  with fake_contents : contents :=
    {| contents.priority := 0; contents.seed_nonce_hash := Some Nonce_hash.zero;
      contents.proof_of_work_nonce :=
        MBytes.create Constants_repr.proof_of_work_nonce_size |} in
  Data_encoding.Binary.length encoding
    {| t.shell := fake_shell;
      t.protocol_data :=
        {| protocol_data.contents := fake_contents;
          protocol_data.signature := Signature.zero |} |}.

Definition hash_raw
  : Tezos_protocol_environment_alpha__Environment.Block_header.t ->
  Tezos_protocol_environment_alpha__Environment.Block_hash.t :=
  Block_header.__hash_value.

Definition __hash_value (function_parameter : t)
  : Tezos_protocol_environment_alpha__Environment.Block_hash.t :=
  let '{| t.shell := shell; t.protocol_data := protocol_data |} :=
    function_parameter in
  Block_header.__hash_value
    {|
      Tezos_protocol_environment_alpha__Environment.Block_header.t.shell :=
        shell;
      Tezos_protocol_environment_alpha__Environment.Block_header.t.protocol_data :=
        Data_encoding.Binary.to_bytes_exn protocol_data_encoding protocol_data
      |}.

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

type t = {shell : Block_header.shell_header; protocol_data : protocol_data}

and protocol_data = {contents : contents; signature : Signature.t}

and contents = {
  priority : int;
  seed_nonce_hash : Nonce_hash.t option;
  proof_of_work_nonce : MBytes.t;
}

type block_header = t

type raw = Block_header.t

type shell_header = Block_header.shell_header

val raw : block_header -> raw

val encoding : block_header Data_encoding.encoding

val raw_encoding : raw Data_encoding.t

val contents_encoding : contents Data_encoding.t

val unsigned_encoding : (Block_header.shell_header * contents) Data_encoding.t

val protocol_data_encoding : protocol_data Data_encoding.encoding

val shell_header_encoding : shell_header Data_encoding.encoding

(** The maximum size of block headers in bytes *)
val max_header_length : int

val hash : block_header -> Block_hash.t

val hash_raw : raw -> Block_hash.t

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Reserved Notation "'t".
Reserved Notation "'protocol_data".
Reserved Notation "'contents".

Module contents_skeleton.
  Record record {priority seed_nonce_hash proof_of_work_nonce : Set} := {
    priority : priority;
    seed_nonce_hash : seed_nonce_hash;
    proof_of_work_nonce : proof_of_work_nonce }.
  Arguments record : clear implicits.
End contents_skeleton.
Definition contents_skeleton := contents_skeleton.record.

Module protocol_data_skeleton.
  Record record {contents signature : Set} := {
    contents : contents;
    signature : signature }.
  Arguments record : clear implicits.
End protocol_data_skeleton.
Definition protocol_data_skeleton := protocol_data_skeleton.record.

Module t_skeleton.
  Record record {shell protocol_data : Set} := {
    shell : shell;
    protocol_data : protocol_data }.
  Arguments record : clear implicits.
End t_skeleton.
Definition t_skeleton := t_skeleton.record.



where "'t" :=
  (t_skeleton
    Tezos_protocol_environment_alpha__Environment.Block_header.shell_header
    'protocol_data)
and "'protocol_data" :=
  (protocol_data_skeleton 'contents
    Tezos_protocol_environment_alpha__Environment.Signature.t)
and "'contents" :=
  (contents_skeleton Z (option Tezos_raw_protocol_alpha.Nonce_hash.t)
    Tezos_protocol_environment_alpha__Environment.MBytes.t).

Definition t := 't.
Definition protocol_data := 'protocol_data.
Definition contents := 'contents.

Definition block_header := t.

Definition raw := Tezos_protocol_environment_alpha__Environment.Block_header.t.

Definition shell_header :=
  Tezos_protocol_environment_alpha__Environment.Block_header.shell_header.

Parameter raw : block_header -> raw.

Parameter encoding :
  Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    block_header.

Parameter raw_encoding :
  Tezos_protocol_environment_alpha__Environment.Data_encoding.t raw.

Parameter contents_encoding :
  Tezos_protocol_environment_alpha__Environment.Data_encoding.t contents.

Parameter unsigned_encoding :
  Tezos_protocol_environment_alpha__Environment.Data_encoding.t
    (Tezos_protocol_environment_alpha__Environment.Block_header.shell_header *
      contents).

Parameter protocol_data_encoding :
  Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    protocol_data.

Parameter shell_header_encoding :
  Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    shell_header.

Parameter max_header_length : Z.

Parameter __hash_value :
  block_header -> Tezos_protocol_environment_alpha__Environment.Block_hash.t.

Parameter hash_raw :
  raw -> Tezos_protocol_environment_alpha__Environment.Block_hash.t.

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Misc

let init_account ctxt
    ({public_key_hash; public_key; amount} : Parameters_repr.bootstrap_account)
    =
  let contract = Contract_repr.implicit_contract public_key_hash in
  Contract_storage.credit ctxt contract amount
  >>=? fun ctxt ->
  match public_key with
  | Some public_key ->
      Contract_storage.reveal_manager_key ctxt public_key_hash public_key
      >>=? fun ctxt ->
      Delegate_storage.set ctxt contract (Some public_key_hash)
      >>=? fun ctxt -> return ctxt
  | None ->
      return ctxt

let init_contract ~typecheck ctxt
    ({delegate; amount; script} : Parameters_repr.bootstrap_contract) =
  Contract_storage.fresh_contract_from_current_nonce ctxt
  >>=? fun (ctxt, contract) ->
  typecheck ctxt script
  >>=? fun (script, ctxt) ->
  Contract_storage.originate
    ctxt
    contract
    ~balance:amount
    ~prepaid_bootstrap_storage:true
    ~script
    ~delegate:(Some delegate)
  >>=? fun ctxt -> return ctxt

let init ctxt ~typecheck ?ramp_up_cycles ?no_reward_cycles accounts contracts =
  let nonce =
    Operation_hash.hash_bytes [MBytes.of_string "Un festival de GADT."]
  in
  let ctxt = Raw_context.init_origination_nonce ctxt nonce in
  fold_left_s init_account ctxt accounts
  >>=? fun ctxt ->
  fold_left_s (init_contract ~typecheck) ctxt contracts
  >>=? fun ctxt ->
  ( match no_reward_cycles with
  | None ->
      return ctxt
  | Some cycles ->
      (* Store pending ramp ups. *)
      let constants = Raw_context.constants ctxt in
      (* Start without reward *)
      Raw_context.patch_constants ctxt (fun c ->
          {
            c with
            block_reward = Tez_repr.zero;
            endorsement_reward = Tez_repr.zero;
          })
      >>= fun ctxt ->
      (* Store the final reward. *)
      Storage.Ramp_up.Rewards.init
        ctxt
        (Cycle_repr.of_int32_exn (Int32.of_int cycles))
        (constants.block_reward, constants.endorsement_reward) )
  >>=? fun ctxt ->
  match ramp_up_cycles with
  | None ->
      return ctxt
  | Some cycles ->
      (* Store pending ramp ups. *)
      let constants = Raw_context.constants ctxt in
      Lwt.return
        Tez_repr.(constants.block_security_deposit /? Int64.of_int cycles)
      >>=? fun block_step ->
      Lwt.return
        Tez_repr.(
          constants.endorsement_security_deposit /? Int64.of_int cycles)
      >>=? fun endorsement_step ->
      (* Start without security_deposit *)
      Raw_context.patch_constants ctxt (fun c ->
          {
            c with
            block_security_deposit = Tez_repr.zero;
            endorsement_security_deposit = Tez_repr.zero;
          })
      >>= fun ctxt ->
      fold_left_s
        (fun ctxt cycle ->
          Lwt.return Tez_repr.(block_step *? Int64.of_int cycle)
          >>=? fun block_security_deposit ->
          Lwt.return Tez_repr.(endorsement_step *? Int64.of_int cycle)
          >>=? fun endorsement_security_deposit ->
          let cycle = Cycle_repr.of_int32_exn (Int32.of_int cycle) in
          Storage.Ramp_up.Security_deposits.init
            ctxt
            cycle
            (block_security_deposit, endorsement_security_deposit))
        ctxt
        (1 --> (cycles - 1))
      >>=? fun ctxt ->
      (* Store the final security deposits. *)
      Storage.Ramp_up.Security_deposits.init
        ctxt
        (Cycle_repr.of_int32_exn (Int32.of_int cycles))
        ( constants.block_security_deposit,
          constants.endorsement_security_deposit )
      >>=? fun ctxt -> return ctxt

let cycle_end ctxt last_cycle =
  let next_cycle = Cycle_repr.succ last_cycle in
  Storage.Ramp_up.Rewards.get_option ctxt next_cycle
  >>=? (function
         | None ->
             return ctxt
         | Some (block_reward, endorsement_reward) ->
             Storage.Ramp_up.Rewards.delete ctxt next_cycle
             >>=? fun ctxt ->
             Raw_context.patch_constants ctxt (fun c ->
                 {c with block_reward; endorsement_reward})
             >>= fun ctxt -> return ctxt)
  >>=? fun ctxt ->
  Storage.Ramp_up.Security_deposits.get_option ctxt next_cycle
  >>=? function
  | None ->
      return ctxt
  | Some (block_security_deposit, endorsement_security_deposit) ->
      Storage.Ramp_up.Security_deposits.delete ctxt next_cycle
      >>=? fun ctxt ->
      Raw_context.patch_constants ctxt (fun c ->
          {c with block_security_deposit; endorsement_security_deposit})
      >>= fun ctxt -> return ctxt

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Import Misc.

Definition init_account
  (ctxt : Tezos_raw_protocol_alpha.Raw_context.t)
  (function_parameter :
    Tezos_raw_protocol_alpha.Parameters_repr.bootstrap_account)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  let '{|
    Tezos_raw_protocol_alpha.Parameters_repr.bootstrap_account.public_key_hash :=
      public_key_hash;
      Tezos_raw_protocol_alpha.Parameters_repr.bootstrap_account.public_key :=
        public_key;
      Tezos_raw_protocol_alpha.Parameters_repr.bootstrap_account.amount :=
        amount
      |} := function_parameter in
  let contract := Contract_repr.implicit_contract public_key_hash in
  op_gtgteqquestion (Contract_storage.credit ctxt contract amount)
    (fun ctxt =>
      match public_key with
      | Some public_key =>
        op_gtgteqquestion
          (Contract_storage.reveal_manager_key ctxt public_key_hash public_key)
          (fun ctxt =>
            op_gtgteqquestion
              (Delegate_storage.set ctxt contract (Some public_key_hash))
              (fun ctxt => __return ctxt))
      | None => __return ctxt
      end).

Definition init_contract
  (typecheck :
    Tezos_raw_protocol_alpha.Raw_context.t ->
    Tezos_raw_protocol_alpha.Script_repr.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        ((Tezos_raw_protocol_alpha.Script_repr.t *
          option Tezos_raw_protocol_alpha.Contract_storage.big_map_diff) *
          Tezos_raw_protocol_alpha.Raw_context.t)))
  (ctxt : Tezos_raw_protocol_alpha.Raw_context.t)
  (function_parameter :
    Tezos_raw_protocol_alpha.Parameters_repr.bootstrap_contract)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  let '{|
    Tezos_raw_protocol_alpha.Parameters_repr.bootstrap_contract.delegate :=
      delegate;
      Tezos_raw_protocol_alpha.Parameters_repr.bootstrap_contract.amount :=
        amount;
      Tezos_raw_protocol_alpha.Parameters_repr.bootstrap_contract.script :=
        script
      |} := function_parameter in
  op_gtgteqquestion (Contract_storage.fresh_contract_from_current_nonce ctxt)
    (fun function_parameter =>
      let '(ctxt, contract) := function_parameter in
      op_gtgteqquestion (typecheck ctxt script)
        (fun function_parameter =>
          let '(script, ctxt) := function_parameter in
          op_gtgteqquestion
            (Contract_storage.originate ctxt (Some true) contract amount script
              (Some delegate)) (fun ctxt => __return ctxt))).

Definition init
  (ctxt : Tezos_raw_protocol_alpha.Raw_context.t)
  (typecheck :
    Tezos_raw_protocol_alpha.Raw_context.t ->
    Tezos_raw_protocol_alpha.Script_repr.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        ((Tezos_raw_protocol_alpha.Script_repr.t *
          option Tezos_raw_protocol_alpha.Contract_storage.big_map_diff) *
          Tezos_raw_protocol_alpha.Raw_context.t))) (ramp_up_cycles : option Z)
  (no_reward_cycles : option Z)
  (accounts : list Tezos_raw_protocol_alpha.Parameters_repr.bootstrap_account)
  (contracts : list Tezos_raw_protocol_alpha.Parameters_repr.bootstrap_contract)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  let nonce :=
    Operation_hash.hash_bytes None
      (cons (MBytes.of_string "Un festival de GADT." % string) []) in
  let ctxt := Raw_context.init_origination_nonce ctxt nonce in
  op_gtgteqquestion (fold_left_s init_account ctxt accounts)
    (fun ctxt =>
      op_gtgteqquestion (fold_left_s (init_contract typecheck) ctxt contracts)
        (fun ctxt =>
          op_gtgteqquestion
            match no_reward_cycles with
            | None => __return ctxt
            | Some cycles =>
              let constants := Raw_context.constants ctxt in
              op_gtgteq
                (Raw_context.patch_constants ctxt
                  (fun c =>
                    (* ❌ Record substitution not handled *)
                    record_substitution))
                (fun ctxt =>
                  Storage.Ramp_up.Rewards.init ctxt
                    (Cycle_repr.of_int32_exn (Int32.of_int cycles))
                    ((Tezos_raw_protocol_alpha.Constants_repr.parametric.block_reward
                      constants),
                      (Tezos_raw_protocol_alpha.Constants_repr.parametric.endorsement_reward
                        constants)))
            end
            (fun ctxt =>
              match ramp_up_cycles with
              | None => __return ctxt
              | Some cycles =>
                let constants := Raw_context.constants ctxt in
                op_gtgteqquestion
                  (Lwt.__return
                    (op_divquestion
                      (Tezos_raw_protocol_alpha.Constants_repr.parametric.block_security_deposit
                        constants) (Int64.of_int cycles)))
                  (fun block_step =>
                    op_gtgteqquestion
                      (Lwt.__return
                        (op_divquestion
                          (Tezos_raw_protocol_alpha.Constants_repr.parametric.endorsement_security_deposit
                            constants) (Int64.of_int cycles)))
                      (fun endorsement_step =>
                        op_gtgteq
                          (Raw_context.patch_constants ctxt
                            (fun c =>
                              (* ❌ Record substitution not handled *)
                              record_substitution))
                          (fun ctxt =>
                            op_gtgteqquestion
                              (fold_left_s
                                (fun ctxt =>
                                  fun cycle =>
                                    op_gtgteqquestion
                                      (Lwt.__return
                                        (op_starquestion block_step
                                          (Int64.of_int cycle)))
                                      (fun block_security_deposit =>
                                        op_gtgteqquestion
                                          (Lwt.__return
                                            (op_starquestion endorsement_step
                                              (Int64.of_int cycle)))
                                          (fun endorsement_security_deposit =>
                                            let cycle :=
                                              Cycle_repr.of_int32_exn
                                                (Int32.of_int cycle) in
                                            Storage.Ramp_up.Security_deposits.init
                                              ctxt cycle
                                              (block_security_deposit,
                                                endorsement_security_deposit))))
                                ctxt (op_minusminusgt 1 (op_minus cycles 1)))
                              (fun ctxt =>
                                op_gtgteqquestion
                                  (Storage.Ramp_up.Security_deposits.init ctxt
                                    (Cycle_repr.of_int32_exn
                                      (Int32.of_int cycles))
                                    ((Tezos_raw_protocol_alpha.Constants_repr.parametric.block_security_deposit
                                      constants),
                                      (Tezos_raw_protocol_alpha.Constants_repr.parametric.endorsement_security_deposit
                                        constants))) (fun ctxt => __return ctxt)))))
              end))).

Definition cycle_end
  (ctxt : Tezos_raw_protocol_alpha.Storage.Ramp_up.Rewards.context)
  (last_cycle : Tezos_raw_protocol_alpha.Cycle_repr.cycle)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Storage.Ramp_up.Rewards.context) :=
  let next_cycle := Cycle_repr.succ last_cycle in
  op_gtgteqquestion
    (op_gtgteqquestion (Storage.Ramp_up.Rewards.get_option ctxt next_cycle)
      (fun function_parameter =>
        match function_parameter with
        | None => __return ctxt
        | Some (block_reward, endorsement_reward) =>
          op_gtgteqquestion (Storage.Ramp_up.Rewards.delete ctxt next_cycle)
            (fun ctxt =>
              op_gtgteq
                (Raw_context.patch_constants ctxt
                  (fun c =>
                    (* ❌ Record substitution not handled *)
                    record_substitution)) (fun ctxt => __return ctxt))
        end))
    (fun ctxt =>
      op_gtgteqquestion
        (Storage.Ramp_up.Security_deposits.get_option ctxt next_cycle)
        (fun function_parameter =>
          match function_parameter with
          | None => __return ctxt
          | Some (block_security_deposit, endorsement_security_deposit) =>
            op_gtgteqquestion
              (Storage.Ramp_up.Security_deposits.delete ctxt next_cycle)
              (fun ctxt =>
                op_gtgteq
                  (Raw_context.patch_constants ctxt
                    (fun c =>
                      (* ❌ Record substitution not handled *)
                      record_substitution)) (fun ctxt => __return ctxt))
          end)).

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

val init :
  Raw_context.t ->
  typecheck:(Raw_context.t ->
            Script_repr.t ->
            ( (Script_repr.t * Contract_storage.big_map_diff option)
            * Raw_context.t )
            tzresult
            Lwt.t) ->
  ?ramp_up_cycles:int ->
  ?no_reward_cycles:int ->
  Parameters_repr.bootstrap_account list ->
  Parameters_repr.bootstrap_contract list ->
  Raw_context.t tzresult Lwt.t

val cycle_end : Raw_context.t -> Cycle_repr.t -> Raw_context.t tzresult Lwt.t

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Parameter init :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  (Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Script_repr.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      ((Tezos_raw_protocol_alpha.Script_repr.t *
        option Tezos_raw_protocol_alpha.Contract_storage.big_map_diff) *
        Tezos_raw_protocol_alpha.Raw_context.t))) -> option Z -> option Z ->
  list Tezos_raw_protocol_alpha.Parameters_repr.bootstrap_account ->
  list Tezos_raw_protocol_alpha.Parameters_repr.bootstrap_contract ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t).

Parameter cycle_end :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Cycle_repr.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t).

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

type t = {
  blinded_public_key_hash : Blinded_public_key_hash.t;
  amount : Tez_repr.t;
}

let encoding =
  let open Data_encoding in
  conv
    (fun {blinded_public_key_hash; amount} ->
      (blinded_public_key_hash, amount))
    (fun (blinded_public_key_hash, amount) ->
      {blinded_public_key_hash; amount})
    (tup2 Blinded_public_key_hash.encoding Tez_repr.encoding)

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Module t.
  Record record := {
    blinded_public_key_hash : Tezos_raw_protocol_alpha.Blinded_public_key_hash.t;
    amount : Tezos_raw_protocol_alpha.Tez_repr.t }.
End t.
Definition t := t.record.

Definition encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding t :=
  conv
    (fun function_parameter =>
      let '{|
        t.blinded_public_key_hash := blinded_public_key_hash;
          t.amount := amount
          |} := function_parameter in
      (blinded_public_key_hash, amount))
    (fun function_parameter =>
      let '(blinded_public_key_hash, amount) := function_parameter in
      {| t.blinded_public_key_hash := blinded_public_key_hash;
        t.amount := amount |}) None
    (tup2 Blinded_public_key_hash.encoding Tez_repr.encoding).

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

type t = {
  blinded_public_key_hash : Blinded_public_key_hash.t;
  amount : Tez_repr.t;
}

val encoding : t Data_encoding.t

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Module t.
  Record record := {
    blinded_public_key_hash : Tezos_raw_protocol_alpha.Blinded_public_key_hash.t;
    amount : Tezos_raw_protocol_alpha.Tez_repr.t }.
End t.
Definition t := t.record.

Parameter encoding :
  Tezos_protocol_environment_alpha__Environment.Data_encoding.t t.

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

let get_opt = Storage.Commitments.get_option

let delete = Storage.Commitments.delete

let init ctxt commitments =
  let init_commitment ctxt Commitment_repr.{blinded_public_key_hash; amount} =
    Storage.Commitments.init ctxt blinded_public_key_hash amount
  in
  fold_left_s init_commitment ctxt commitments >>=? fun ctxt -> return ctxt

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Definition get_opt
  : Tezos_raw_protocol_alpha.Storage.Commitments.context ->
  Tezos_raw_protocol_alpha.Storage.Commitments.key ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (option Tezos_raw_protocol_alpha.Storage.Commitments.value)) :=
  Storage.Commitments.get_option.

Definition delete
  : Tezos_raw_protocol_alpha.Storage.Commitments.context ->
  Tezos_raw_protocol_alpha.Storage.Commitments.key ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) := Storage.Commitments.delete.

Definition init
  (ctxt : Tezos_raw_protocol_alpha.Storage.Commitments.context)
  (commitments : list Tezos_raw_protocol_alpha.Commitment_repr.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Storage.Commitments.context) :=
  let init_commitment
    (ctxt : Tezos_raw_protocol_alpha.Storage.Commitments.context)
    (function_parameter : Tezos_raw_protocol_alpha.Commitment_repr.t)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        Tezos_raw_protocol_alpha.Raw_context.t) :=
    let '{|
      Tezos_raw_protocol_alpha.Commitment_repr.t.blinded_public_key_hash :=
        blinded_public_key_hash;
        Tezos_raw_protocol_alpha.Commitment_repr.t.amount := amount
        |} := function_parameter in
    Storage.Commitments.init ctxt blinded_public_key_hash amount in
  op_gtgteqquestion (fold_left_s init_commitment ctxt commitments)
    (fun ctxt => __return ctxt).

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

val init :
  Raw_context.t -> Commitment_repr.t list -> Raw_context.t tzresult Lwt.t

val get_opt :
  Raw_context.t ->
  Blinded_public_key_hash.t ->
  Tez_repr.t option tzresult Lwt.t

val delete :
  Raw_context.t -> Blinded_public_key_hash.t -> Raw_context.t tzresult Lwt.t

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Parameter init :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  list Tezos_raw_protocol_alpha.Commitment_repr.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t).

Parameter get_opt :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Blinded_public_key_hash.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (option Tezos_raw_protocol_alpha.Tez_repr.t)).

Parameter delete :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Blinded_public_key_hash.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t).

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

let version_number_004 = "\000"

let version_number = "\001"

let proof_of_work_nonce_size = 8

let nonce_length = 32

let max_revelations_per_block = 32

let max_proposals_per_delegate = 20

let max_operation_data_length = 16 * 1024 (* 16kB *)

type fixed = {
  proof_of_work_nonce_size : int;
  nonce_length : int;
  max_revelations_per_block : int;
  max_operation_data_length : int;
  max_proposals_per_delegate : int;
}

let fixed_encoding =
  let open Data_encoding in
  conv
    (fun c ->
      ( c.proof_of_work_nonce_size,
        c.nonce_length,
        c.max_revelations_per_block,
        c.max_operation_data_length,
        c.max_proposals_per_delegate ))
    (fun ( proof_of_work_nonce_size,
           nonce_length,
           max_revelations_per_block,
           max_operation_data_length,
           max_proposals_per_delegate ) ->
      {
        proof_of_work_nonce_size;
        nonce_length;
        max_revelations_per_block;
        max_operation_data_length;
        max_proposals_per_delegate;
      })
    (obj5
       (req "proof_of_work_nonce_size" uint8)
       (req "nonce_length" uint8)
       (req "max_revelations_per_block" uint8)
       (req "max_operation_data_length" int31)
       (req "max_proposals_per_delegate" uint8))

let fixed =
  {
    proof_of_work_nonce_size;
    nonce_length;
    max_revelations_per_block;
    max_operation_data_length;
    max_proposals_per_delegate;
  }

type parametric = {
  preserved_cycles : int;
  blocks_per_cycle : int32;
  blocks_per_commitment : int32;
  blocks_per_roll_snapshot : int32;
  blocks_per_voting_period : int32;
  time_between_blocks : Period_repr.t list;
  endorsers_per_block : int;
  hard_gas_limit_per_operation : Z.t;
  hard_gas_limit_per_block : Z.t;
  proof_of_work_threshold : int64;
  tokens_per_roll : Tez_repr.t;
  michelson_maximum_type_size : int;
  seed_nonce_revelation_tip : Tez_repr.t;
  origination_size : int;
  block_security_deposit : Tez_repr.t;
  endorsement_security_deposit : Tez_repr.t;
  block_reward : Tez_repr.t;
  endorsement_reward : Tez_repr.t;
  cost_per_byte : Tez_repr.t;
  hard_storage_limit_per_operation : Z.t;
  test_chain_duration : int64;
  (* in seconds *)
  quorum_min : int32;
  quorum_max : int32;
  min_proposal_quorum : int32;
  initial_endorsers : int;
  delay_per_missing_endorsement : Period_repr.t;
}

let parametric_encoding =
  let open Data_encoding in
  conv
    (fun c ->
      ( ( c.preserved_cycles,
          c.blocks_per_cycle,
          c.blocks_per_commitment,
          c.blocks_per_roll_snapshot,
          c.blocks_per_voting_period,
          c.time_between_blocks,
          c.endorsers_per_block,
          c.hard_gas_limit_per_operation,
          c.hard_gas_limit_per_block ),
        ( ( c.proof_of_work_threshold,
            c.tokens_per_roll,
            c.michelson_maximum_type_size,
            c.seed_nonce_revelation_tip,
            c.origination_size,
            c.block_security_deposit,
            c.endorsement_security_deposit,
            c.block_reward ),
          ( c.endorsement_reward,
            c.cost_per_byte,
            c.hard_storage_limit_per_operation,
            c.test_chain_duration,
            c.quorum_min,
            c.quorum_max,
            c.min_proposal_quorum,
            c.initial_endorsers,
            c.delay_per_missing_endorsement ) ) ))
    (fun ( ( preserved_cycles,
             blocks_per_cycle,
             blocks_per_commitment,
             blocks_per_roll_snapshot,
             blocks_per_voting_period,
             time_between_blocks,
             endorsers_per_block,
             hard_gas_limit_per_operation,
             hard_gas_limit_per_block ),
           ( ( proof_of_work_threshold,
               tokens_per_roll,
               michelson_maximum_type_size,
               seed_nonce_revelation_tip,
               origination_size,
               block_security_deposit,
               endorsement_security_deposit,
               block_reward ),
             ( endorsement_reward,
               cost_per_byte,
               hard_storage_limit_per_operation,
               test_chain_duration,
               quorum_min,
               quorum_max,
               min_proposal_quorum,
               initial_endorsers,
               delay_per_missing_endorsement ) ) ) ->
      {
        preserved_cycles;
        blocks_per_cycle;
        blocks_per_commitment;
        blocks_per_roll_snapshot;
        blocks_per_voting_period;
        time_between_blocks;
        endorsers_per_block;
        hard_gas_limit_per_operation;
        hard_gas_limit_per_block;
        proof_of_work_threshold;
        tokens_per_roll;
        michelson_maximum_type_size;
        seed_nonce_revelation_tip;
        origination_size;
        block_security_deposit;
        endorsement_security_deposit;
        block_reward;
        endorsement_reward;
        cost_per_byte;
        hard_storage_limit_per_operation;
        test_chain_duration;
        quorum_min;
        quorum_max;
        min_proposal_quorum;
        initial_endorsers;
        delay_per_missing_endorsement;
      })
    (merge_objs
       (obj9
          (req "preserved_cycles" uint8)
          (req "blocks_per_cycle" int32)
          (req "blocks_per_commitment" int32)
          (req "blocks_per_roll_snapshot" int32)
          (req "blocks_per_voting_period" int32)
          (req "time_between_blocks" (list Period_repr.encoding))
          (req "endorsers_per_block" uint16)
          (req "hard_gas_limit_per_operation" z)
          (req "hard_gas_limit_per_block" z))
       (merge_objs
          (obj8
             (req "proof_of_work_threshold" int64)
             (req "tokens_per_roll" Tez_repr.encoding)
             (req "michelson_maximum_type_size" uint16)
             (req "seed_nonce_revelation_tip" Tez_repr.encoding)
             (req "origination_size" int31)
             (req "block_security_deposit" Tez_repr.encoding)
             (req "endorsement_security_deposit" Tez_repr.encoding)
             (req "block_reward" Tez_repr.encoding))
          (obj9
             (req "endorsement_reward" Tez_repr.encoding)
             (req "cost_per_byte" Tez_repr.encoding)
             (req "hard_storage_limit_per_operation" z)
             (req "test_chain_duration" int64)
             (req "quorum_min" int32)
             (req "quorum_max" int32)
             (req "min_proposal_quorum" int32)
             (req "initial_endorsers" uint16)
             (req "delay_per_missing_endorsement" Period_repr.encoding))))

type t = {fixed : fixed; parametric : parametric}

let encoding =
  let open Data_encoding in
  conv
    (fun {fixed; parametric} -> (fixed, parametric))
    (fun (fixed, parametric) -> {fixed; parametric})
    (merge_objs fixed_encoding parametric_encoding)

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Definition version_number_004 : string := "" % string.

Definition version_number : string := "
" % string.

Definition proof_of_work_nonce_size : Z := 8.

Definition nonce_length : Z := 32.

Definition max_revelations_per_block : Z := 32.

Definition max_proposals_per_delegate : Z := 20.

Definition max_operation_data_length : Z := op_star 16 1024.

Module fixed.
  Record record := {
    proof_of_work_nonce_size : Z;
    nonce_length : Z;
    max_revelations_per_block : Z;
    max_operation_data_length : Z;
    max_proposals_per_delegate : Z }.
End fixed.
Definition fixed := fixed.record.

Definition fixed_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding fixed :=
  conv
    (fun c =>
      ((fixed.proof_of_work_nonce_size c), (fixed.nonce_length c),
        (fixed.max_revelations_per_block c),
        (fixed.max_operation_data_length c),
        (fixed.max_proposals_per_delegate c)))
    (fun function_parameter =>
      let
        '(proof_of_work_nonce_size, nonce_length, max_revelations_per_block,
          max_operation_data_length, max_proposals_per_delegate) :=
        function_parameter in
      {| fixed.proof_of_work_nonce_size := proof_of_work_nonce_size;
        fixed.nonce_length := nonce_length;
        fixed.max_revelations_per_block := max_revelations_per_block;
        fixed.max_operation_data_length := max_operation_data_length;
        fixed.max_proposals_per_delegate := max_proposals_per_delegate |}) None
    (obj5 (req None None "proof_of_work_nonce_size" % string uint8)
      (req None None "nonce_length" % string uint8)
      (req None None "max_revelations_per_block" % string uint8)
      (req None None "max_operation_data_length" % string int31)
      (req None None "max_proposals_per_delegate" % string uint8)).

Definition fixed : fixed :=
  {| fixed.proof_of_work_nonce_size := proof_of_work_nonce_size;
    fixed.nonce_length := nonce_length;
    fixed.max_revelations_per_block := max_revelations_per_block;
    fixed.max_operation_data_length := max_operation_data_length;
    fixed.max_proposals_per_delegate := max_proposals_per_delegate |}.

Module parametric.
  Record record := {
    preserved_cycles : Z;
    blocks_per_cycle : int32;
    blocks_per_commitment : int32;
    blocks_per_roll_snapshot : int32;
    blocks_per_voting_period : int32;
    time_between_blocks : list Tezos_raw_protocol_alpha.Period_repr.t;
    endorsers_per_block : Z;
    hard_gas_limit_per_operation :
      Tezos_protocol_environment_alpha__Environment.Z.t;
    hard_gas_limit_per_block : Tezos_protocol_environment_alpha__Environment.Z.t;
    proof_of_work_threshold : int64;
    tokens_per_roll : Tezos_raw_protocol_alpha.Tez_repr.t;
    michelson_maximum_type_size : Z;
    seed_nonce_revelation_tip : Tezos_raw_protocol_alpha.Tez_repr.t;
    origination_size : Z;
    block_security_deposit : Tezos_raw_protocol_alpha.Tez_repr.t;
    endorsement_security_deposit : Tezos_raw_protocol_alpha.Tez_repr.t;
    block_reward : Tezos_raw_protocol_alpha.Tez_repr.t;
    endorsement_reward : Tezos_raw_protocol_alpha.Tez_repr.t;
    cost_per_byte : Tezos_raw_protocol_alpha.Tez_repr.t;
    hard_storage_limit_per_operation :
      Tezos_protocol_environment_alpha__Environment.Z.t;
    test_chain_duration : int64;
    quorum_min : int32;
    quorum_max : int32;
    min_proposal_quorum : int32;
    initial_endorsers : Z;
    delay_per_missing_endorsement : Tezos_raw_protocol_alpha.Period_repr.t }.
End parametric.
Definition parametric := parametric.record.

Definition parametric_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    parametric :=
  conv
    (fun c =>
      (((parametric.preserved_cycles c), (parametric.blocks_per_cycle c),
        (parametric.blocks_per_commitment c),
        (parametric.blocks_per_roll_snapshot c),
        (parametric.blocks_per_voting_period c),
        (parametric.time_between_blocks c), (parametric.endorsers_per_block c),
        (parametric.hard_gas_limit_per_operation c),
        (parametric.hard_gas_limit_per_block c)),
        (((parametric.proof_of_work_threshold c),
          (parametric.tokens_per_roll c),
          (parametric.michelson_maximum_type_size c),
          (parametric.seed_nonce_revelation_tip c),
          (parametric.origination_size c),
          (parametric.block_security_deposit c),
          (parametric.endorsement_security_deposit c),
          (parametric.block_reward c)),
          ((parametric.endorsement_reward c), (parametric.cost_per_byte c),
            (parametric.hard_storage_limit_per_operation c),
            (parametric.test_chain_duration c), (parametric.quorum_min c),
            (parametric.quorum_max c), (parametric.min_proposal_quorum c),
            (parametric.initial_endorsers c),
            (parametric.delay_per_missing_endorsement c)))))
    (fun function_parameter =>
      let
        '((preserved_cycles, blocks_per_cycle, blocks_per_commitment,
          blocks_per_roll_snapshot, blocks_per_voting_period,
          time_between_blocks, endorsers_per_block,
          hard_gas_limit_per_operation, hard_gas_limit_per_block),
          ((proof_of_work_threshold, tokens_per_roll,
            michelson_maximum_type_size, seed_nonce_revelation_tip,
            origination_size, block_security_deposit,
            endorsement_security_deposit, block_reward),
            (endorsement_reward, cost_per_byte,
              hard_storage_limit_per_operation, test_chain_duration, quorum_min,
              quorum_max, min_proposal_quorum, initial_endorsers,
              delay_per_missing_endorsement))) := function_parameter in
      {| parametric.preserved_cycles := preserved_cycles;
        parametric.blocks_per_cycle := blocks_per_cycle;
        parametric.blocks_per_commitment := blocks_per_commitment;
        parametric.blocks_per_roll_snapshot := blocks_per_roll_snapshot;
        parametric.blocks_per_voting_period := blocks_per_voting_period;
        parametric.time_between_blocks := time_between_blocks;
        parametric.endorsers_per_block := endorsers_per_block;
        parametric.hard_gas_limit_per_operation := hard_gas_limit_per_operation;
        parametric.hard_gas_limit_per_block := hard_gas_limit_per_block;
        parametric.proof_of_work_threshold := proof_of_work_threshold;
        parametric.tokens_per_roll := tokens_per_roll;
        parametric.michelson_maximum_type_size := michelson_maximum_type_size;
        parametric.seed_nonce_revelation_tip := seed_nonce_revelation_tip;
        parametric.origination_size := origination_size;
        parametric.block_security_deposit := block_security_deposit;
        parametric.endorsement_security_deposit := endorsement_security_deposit;
        parametric.block_reward := block_reward;
        parametric.endorsement_reward := endorsement_reward;
        parametric.cost_per_byte := cost_per_byte;
        parametric.hard_storage_limit_per_operation :=
          hard_storage_limit_per_operation;
        parametric.test_chain_duration := test_chain_duration;
        parametric.quorum_min := quorum_min;
        parametric.quorum_max := quorum_max;
        parametric.min_proposal_quorum := min_proposal_quorum;
        parametric.initial_endorsers := initial_endorsers;
        parametric.delay_per_missing_endorsement :=
          delay_per_missing_endorsement |}) None
    (merge_objs
      (obj9 (req None None "preserved_cycles" % string uint8)
        (req None None "blocks_per_cycle" % string __int32_value)
        (req None None "blocks_per_commitment" % string __int32_value)
        (req None None "blocks_per_roll_snapshot" % string __int32_value)
        (req None None "blocks_per_voting_period" % string __int32_value)
        (req None None "time_between_blocks" % string
          (__list_value None Period_repr.encoding))
        (req None None "endorsers_per_block" % string uint16)
        (req None None "hard_gas_limit_per_operation" % string z)
        (req None None "hard_gas_limit_per_block" % string z))
      (merge_objs
        (obj8 (req None None "proof_of_work_threshold" % string __int64_value)
          (req None None "tokens_per_roll" % string Tez_repr.encoding)
          (req None None "michelson_maximum_type_size" % string uint16)
          (req None None "seed_nonce_revelation_tip" % string Tez_repr.encoding)
          (req None None "origination_size" % string int31)
          (req None None "block_security_deposit" % string Tez_repr.encoding)
          (req None None "endorsement_security_deposit" % string
            Tez_repr.encoding)
          (req None None "block_reward" % string Tez_repr.encoding))
        (obj9 (req None None "endorsement_reward" % string Tez_repr.encoding)
          (req None None "cost_per_byte" % string Tez_repr.encoding)
          (req None None "hard_storage_limit_per_operation" % string z)
          (req None None "test_chain_duration" % string __int64_value)
          (req None None "quorum_min" % string __int32_value)
          (req None None "quorum_max" % string __int32_value)
          (req None None "min_proposal_quorum" % string __int32_value)
          (req None None "initial_endorsers" % string uint16)
          (req None None "delay_per_missing_endorsement" % string
            Period_repr.encoding)))).

Module t.
  Record record := {
    fixed : fixed;
    parametric : parametric }.
End t.
Definition t := t.record.

Definition encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding t :=
  conv
    (fun function_parameter =>
      let '{| t.fixed := fixed; t.parametric := parametric |} :=
        function_parameter in
      (fixed, parametric))
    (fun function_parameter =>
      let '(fixed, parametric) := function_parameter in
      {| t.fixed := fixed; t.parametric := parametric |}) None
    (merge_objs fixed_encoding parametric_encoding).

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Alpha_context

let custom_root =
  ( RPC_path.(open_root / "context" / "constants")
    : RPC_context.t RPC_path.context )

module S = struct
  open Data_encoding

  let errors =
    RPC_service.get_service
      ~description:"Schema for all the RPC errors from this protocol version"
      ~query:RPC_query.empty
      ~output:json_schema
      RPC_path.(custom_root / "errors")

  let all =
    RPC_service.get_service
      ~description:"All constants"
      ~query:RPC_query.empty
      ~output:Alpha_context.Constants.encoding
      custom_root
end

let register () =
  let open Services_registration in
  register0_noctxt S.errors (fun () () ->
      return Data_encoding.Json.(schema error_encoding)) ;
  register0 S.all (fun ctxt () () ->
      let open Constants in
      return {fixed; parametric = parametric ctxt})

let errors ctxt block = RPC_context.make_call0 S.errors ctxt block () ()

let all ctxt block = RPC_context.make_call0 S.all ctxt block () ()

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Import Alpha_context.

Definition custom_root
  : Tezos_protocol_environment_alpha__Environment.RPC_path.context
    Tezos_protocol_environment_alpha__Environment.RPC_context.t :=
  op_div (op_div open_root "context" % string) "constants" % string.

Module S.
  Import Data_encoding.
  
  Definition errors
    : Tezos_protocol_environment_alpha__Environment.RPC_service.service
      (* `GET *) unit
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t unit unit
      Tezos_protocol_environment_alpha__Environment.Data_encoding.json_schema :=
    RPC_service.get_service
      (Some "Schema for all the RPC errors from this protocol version" % string)
      RPC_query.empty __json_schema_value (op_div custom_root "errors" % string).
  
  Definition all
    : Tezos_protocol_environment_alpha__Environment.RPC_service.service
      (* `GET *) unit
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t unit unit
      Tezos_raw_protocol_alpha.Alpha_context.Constants.t :=
    RPC_service.get_service (Some "All constants" % string) RPC_query.empty
      Alpha_context.Constants.encoding custom_root.
End S.

Definition register (function_parameter : unit) : unit :=
  let 'tt := function_parameter in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register0_noctxt S.errors
      (fun function_parameter =>
        let 'tt := function_parameter in
        fun function_parameter =>
          let 'tt := function_parameter in
          __return (schema None error_encoding)) in
  register0 S.all
    (fun ctxt =>
      fun function_parameter =>
        let 'tt := function_parameter in
        fun function_parameter =>
          let 'tt := function_parameter in
          __return
            {|
              Tezos_raw_protocol_alpha.Alpha_context.Constants.t.fixed := fixed;
              Tezos_raw_protocol_alpha.Alpha_context.Constants.t.parametric :=
                parametric ctxt |}).

Definition errors {D E G I K L a b c i o q : Set}
  (ctxt :
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
        (* `POST *) unit + (* `PUT *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> D ->
    q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
          (* `POST *) unit + (* `PUT *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
      -> D -> a -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (G * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
            (* `POST *) unit + (* `PUT *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o -> D -> a -> b -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (I * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
              (* `POST *) unit + (* `PUT *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o -> D -> a -> b -> c -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (K * a * b * c * q * i * o)) * L)))) * L * D) (block : D)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      Tezos_protocol_environment_alpha__Environment.Data_encoding.json_schema) :=
  RPC_context.make_call0 S.errors ctxt block tt tt.

Definition all {D E G I K L a b c i o q : Set}
  (ctxt :
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
        (* `POST *) unit + (* `PUT *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> D ->
    q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
          (* `POST *) unit + (* `PUT *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
      -> D -> a -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (G * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
            (* `POST *) unit + (* `PUT *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o -> D -> a -> b -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (I * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
              (* `POST *) unit + (* `PUT *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o -> D -> a -> b -> c -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (K * a * b * c * q * i * o)) * L)))) * L * D) (block : D)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      Tezos_raw_protocol_alpha.Alpha_context.Constants.t) :=
  RPC_context.make_call0 S.all ctxt block tt tt.

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Alpha_context

val errors :
  'a #RPC_context.simple ->
  'a ->
  Data_encoding.json_schema shell_tzresult Lwt.t

(** Returns all the constants of the protocol *)
val all : 'a #RPC_context.simple -> 'a -> Constants.t shell_tzresult Lwt.t

val register : unit -> unit

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Parameter errors : forall {E F H J K a b c i o q : Set},
  (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
    ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit +
      (* `PATCH *) unit)
    Tezos_protocol_environment_alpha__Environment.RPC_context.t
    Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> a ->
  q -> i ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult o))
    * (E * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit
        + (* `PATCH *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
    a -> a -> q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (F * a * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
          (* `POST *) unit + (* `PATCH *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
        q i o -> a -> a -> b -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (H * a * b * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
            (* `POST *) unit + (* `PATCH *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
            b) * c) q i o -> a -> a -> b -> c -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (J * a * b * c * q * i * o)) * K)))) * K * a -> a ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      Tezos_protocol_environment_alpha__Environment.Data_encoding.json_schema).

Parameter all : forall {E F H J K a b c i o q : Set},
  (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
    ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit +
      (* `PATCH *) unit)
    Tezos_protocol_environment_alpha__Environment.RPC_context.t
    Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> a ->
  q -> i ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult o))
    * (E * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit
        + (* `PATCH *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
    a -> a -> q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (F * a * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
          (* `POST *) unit + (* `PATCH *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
        q i o -> a -> a -> b -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (H * a * b * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
            (* `POST *) unit + (* `PATCH *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
            b) * c) q i o -> a -> a -> b -> c -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (J * a * b * c * q * i * o)) * K)))) * K * a -> a ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      Tezos_raw_protocol_alpha.Alpha_context.Constants.t).

Parameter register : unit -> unit.

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

let preserved_cycles c =
  let constants = Raw_context.constants c in
  constants.preserved_cycles

let blocks_per_cycle c =
  let constants = Raw_context.constants c in
  constants.blocks_per_cycle

let blocks_per_commitment c =
  let constants = Raw_context.constants c in
  constants.blocks_per_commitment

let blocks_per_roll_snapshot c =
  let constants = Raw_context.constants c in
  constants.blocks_per_roll_snapshot

let blocks_per_voting_period c =
  let constants = Raw_context.constants c in
  constants.blocks_per_voting_period

let time_between_blocks c =
  let constants = Raw_context.constants c in
  constants.time_between_blocks

let endorsers_per_block c =
  let constants = Raw_context.constants c in
  constants.endorsers_per_block

let initial_endorsers c =
  let constants = Raw_context.constants c in
  constants.initial_endorsers

let delay_per_missing_endorsement c =
  let constants = Raw_context.constants c in
  constants.delay_per_missing_endorsement

let hard_gas_limit_per_operation c =
  let constants = Raw_context.constants c in
  constants.hard_gas_limit_per_operation

let hard_gas_limit_per_block c =
  let constants = Raw_context.constants c in
  constants.hard_gas_limit_per_block

let cost_per_byte c =
  let constants = Raw_context.constants c in
  constants.cost_per_byte

let hard_storage_limit_per_operation c =
  let constants = Raw_context.constants c in
  constants.hard_storage_limit_per_operation

let proof_of_work_threshold c =
  let constants = Raw_context.constants c in
  constants.proof_of_work_threshold

let tokens_per_roll c =
  let constants = Raw_context.constants c in
  constants.tokens_per_roll

let michelson_maximum_type_size c =
  let constants = Raw_context.constants c in
  constants.michelson_maximum_type_size

let seed_nonce_revelation_tip c =
  let constants = Raw_context.constants c in
  constants.seed_nonce_revelation_tip

let origination_size c =
  let constants = Raw_context.constants c in
  constants.origination_size

let block_security_deposit c =
  let constants = Raw_context.constants c in
  constants.block_security_deposit

let endorsement_security_deposit c =
  let constants = Raw_context.constants c in
  constants.endorsement_security_deposit

let block_reward c =
  let constants = Raw_context.constants c in
  constants.block_reward

let endorsement_reward c =
  let constants = Raw_context.constants c in
  constants.endorsement_reward

let test_chain_duration c =
  let constants = Raw_context.constants c in
  constants.test_chain_duration

let quorum_min c =
  let constants = Raw_context.constants c in
  constants.quorum_min

let quorum_max c =
  let constants = Raw_context.constants c in
  constants.quorum_max

let min_proposal_quorum c =
  let constants = Raw_context.constants c in
  constants.min_proposal_quorum

let parametric c = Raw_context.constants c

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Definition preserved_cycles (c : Tezos_raw_protocol_alpha.Raw_context.context)
  : Z :=
  let constants := Raw_context.constants c in
  Tezos_raw_protocol_alpha.Constants_repr.parametric.preserved_cycles constants.

Definition blocks_per_cycle (c : Tezos_raw_protocol_alpha.Raw_context.context)
  : int32 :=
  let constants := Raw_context.constants c in
  Tezos_raw_protocol_alpha.Constants_repr.parametric.blocks_per_cycle constants.

Definition blocks_per_commitment
  (c : Tezos_raw_protocol_alpha.Raw_context.context) : int32 :=
  let constants := Raw_context.constants c in
  Tezos_raw_protocol_alpha.Constants_repr.parametric.blocks_per_commitment
    constants.

Definition blocks_per_roll_snapshot
  (c : Tezos_raw_protocol_alpha.Raw_context.context) : int32 :=
  let constants := Raw_context.constants c in
  Tezos_raw_protocol_alpha.Constants_repr.parametric.blocks_per_roll_snapshot
    constants.

Definition blocks_per_voting_period
  (c : Tezos_raw_protocol_alpha.Raw_context.context) : int32 :=
  let constants := Raw_context.constants c in
  Tezos_raw_protocol_alpha.Constants_repr.parametric.blocks_per_voting_period
    constants.

Definition time_between_blocks
  (c : Tezos_raw_protocol_alpha.Raw_context.context)
  : list Tezos_raw_protocol_alpha.Period_repr.t :=
  let constants := Raw_context.constants c in
  Tezos_raw_protocol_alpha.Constants_repr.parametric.time_between_blocks
    constants.

Definition endorsers_per_block
  (c : Tezos_raw_protocol_alpha.Raw_context.context) : Z :=
  let constants := Raw_context.constants c in
  Tezos_raw_protocol_alpha.Constants_repr.parametric.endorsers_per_block
    constants.

Definition initial_endorsers (c : Tezos_raw_protocol_alpha.Raw_context.context)
  : Z :=
  let constants := Raw_context.constants c in
  Tezos_raw_protocol_alpha.Constants_repr.parametric.initial_endorsers constants.

Definition delay_per_missing_endorsement
  (c : Tezos_raw_protocol_alpha.Raw_context.context)
  : Tezos_raw_protocol_alpha.Period_repr.t :=
  let constants := Raw_context.constants c in
  Tezos_raw_protocol_alpha.Constants_repr.parametric.delay_per_missing_endorsement
    constants.

Definition hard_gas_limit_per_operation
  (c : Tezos_raw_protocol_alpha.Raw_context.context)
  : Tezos_protocol_environment_alpha__Environment.Z.t :=
  let constants := Raw_context.constants c in
  Tezos_raw_protocol_alpha.Constants_repr.parametric.hard_gas_limit_per_operation
    constants.

Definition hard_gas_limit_per_block
  (c : Tezos_raw_protocol_alpha.Raw_context.context)
  : Tezos_protocol_environment_alpha__Environment.Z.t :=
  let constants := Raw_context.constants c in
  Tezos_raw_protocol_alpha.Constants_repr.parametric.hard_gas_limit_per_block
    constants.

Definition cost_per_byte (c : Tezos_raw_protocol_alpha.Raw_context.context)
  : Tezos_raw_protocol_alpha.Tez_repr.t :=
  let constants := Raw_context.constants c in
  Tezos_raw_protocol_alpha.Constants_repr.parametric.cost_per_byte constants.

Definition hard_storage_limit_per_operation
  (c : Tezos_raw_protocol_alpha.Raw_context.context)
  : Tezos_protocol_environment_alpha__Environment.Z.t :=
  let constants := Raw_context.constants c in
  Tezos_raw_protocol_alpha.Constants_repr.parametric.hard_storage_limit_per_operation
    constants.

Definition proof_of_work_threshold
  (c : Tezos_raw_protocol_alpha.Raw_context.context) : int64 :=
  let constants := Raw_context.constants c in
  Tezos_raw_protocol_alpha.Constants_repr.parametric.proof_of_work_threshold
    constants.

Definition tokens_per_roll (c : Tezos_raw_protocol_alpha.Raw_context.context)
  : Tezos_raw_protocol_alpha.Tez_repr.t :=
  let constants := Raw_context.constants c in
  Tezos_raw_protocol_alpha.Constants_repr.parametric.tokens_per_roll constants.

Definition michelson_maximum_type_size
  (c : Tezos_raw_protocol_alpha.Raw_context.context) : Z :=
  let constants := Raw_context.constants c in
  Tezos_raw_protocol_alpha.Constants_repr.parametric.michelson_maximum_type_size
    constants.

Definition seed_nonce_revelation_tip
  (c : Tezos_raw_protocol_alpha.Raw_context.context)
  : Tezos_raw_protocol_alpha.Tez_repr.t :=
  let constants := Raw_context.constants c in
  Tezos_raw_protocol_alpha.Constants_repr.parametric.seed_nonce_revelation_tip
    constants.

Definition origination_size (c : Tezos_raw_protocol_alpha.Raw_context.context)
  : Z :=
  let constants := Raw_context.constants c in
  Tezos_raw_protocol_alpha.Constants_repr.parametric.origination_size constants.

Definition block_security_deposit
  (c : Tezos_raw_protocol_alpha.Raw_context.context)
  : Tezos_raw_protocol_alpha.Tez_repr.t :=
  let constants := Raw_context.constants c in
  Tezos_raw_protocol_alpha.Constants_repr.parametric.block_security_deposit
    constants.

Definition endorsement_security_deposit
  (c : Tezos_raw_protocol_alpha.Raw_context.context)
  : Tezos_raw_protocol_alpha.Tez_repr.t :=
  let constants := Raw_context.constants c in
  Tezos_raw_protocol_alpha.Constants_repr.parametric.endorsement_security_deposit
    constants.

Definition block_reward (c : Tezos_raw_protocol_alpha.Raw_context.context)
  : Tezos_raw_protocol_alpha.Tez_repr.t :=
  let constants := Raw_context.constants c in
  Tezos_raw_protocol_alpha.Constants_repr.parametric.block_reward constants.

Definition endorsement_reward (c : Tezos_raw_protocol_alpha.Raw_context.context)
  : Tezos_raw_protocol_alpha.Tez_repr.t :=
  let constants := Raw_context.constants c in
  Tezos_raw_protocol_alpha.Constants_repr.parametric.endorsement_reward
    constants.

Definition test_chain_duration
  (c : Tezos_raw_protocol_alpha.Raw_context.context) : int64 :=
  let constants := Raw_context.constants c in
  Tezos_raw_protocol_alpha.Constants_repr.parametric.test_chain_duration
    constants.

Definition quorum_min (c : Tezos_raw_protocol_alpha.Raw_context.context)
  : int32 :=
  let constants := Raw_context.constants c in
  Tezos_raw_protocol_alpha.Constants_repr.parametric.quorum_min constants.

Definition quorum_max (c : Tezos_raw_protocol_alpha.Raw_context.context)
  : int32 :=
  let constants := Raw_context.constants c in
  Tezos_raw_protocol_alpha.Constants_repr.parametric.quorum_max constants.

Definition min_proposal_quorum
  (c : Tezos_raw_protocol_alpha.Raw_context.context) : int32 :=
  let constants := Raw_context.constants c in
  Tezos_raw_protocol_alpha.Constants_repr.parametric.min_proposal_quorum
    constants.

Definition parametric (c : Tezos_raw_protocol_alpha.Raw_context.context)
  : Tezos_raw_protocol_alpha.Constants_repr.parametric :=
  Raw_context.constants c.

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

(* 20 *)
let contract_hash = "\002\090\121" (* KT1(36) *)

include Blake2B.Make
          (Base58)
          (struct
            let name = "Contract_hash"

            let title = "A contract ID"

            let b58check_prefix = contract_hash

            let size = Some 20
          end)

let () = Base58.check_encoded_prefix b58check_encoding "KT1" 36

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Definition contract_hash : string := "Zy" % string.

(* ❌ Cannot include this kind of module expression *)
include

(* ❌ Top-level evaluations are considered as an error as sources of side-effects *)
Compute Base58.check_encoded_prefix b58check_encoding "KT1" % string 36.

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

type t =
  | Implicit of Signature.Public_key_hash.t
  | Originated of Contract_hash.t

include Compare.Make (struct
  type nonrec t = t

  let compare l1 l2 =
    match (l1, l2) with
    | (Implicit pkh1, Implicit pkh2) ->
        Signature.Public_key_hash.compare pkh1 pkh2
    | (Originated h1, Originated h2) ->
        Contract_hash.compare h1 h2
    | (Implicit _, Originated _) ->
        -1
    | (Originated _, Implicit _) ->
        1
end)

type contract = t

type error += Invalid_contract_notation of string (* `Permanent *)

let to_b58check = function
  | Implicit pbk ->
      Signature.Public_key_hash.to_b58check pbk
  | Originated h ->
      Contract_hash.to_b58check h

let of_b58check s =
  match Base58.decode s with
  | Some (Ed25519.Public_key_hash.Data h) ->
      ok (Implicit (Signature.Ed25519 h))
  | Some (Secp256k1.Public_key_hash.Data h) ->
      ok (Implicit (Signature.Secp256k1 h))
  | Some (P256.Public_key_hash.Data h) ->
      ok (Implicit (Signature.P256 h))
  | Some (Contract_hash.Data h) ->
      ok (Originated h)
  | _ ->
      error (Invalid_contract_notation s)

let pp ppf = function
  | Implicit pbk ->
      Signature.Public_key_hash.pp ppf pbk
  | Originated h ->
      Contract_hash.pp ppf h

let pp_short ppf = function
  | Implicit pbk ->
      Signature.Public_key_hash.pp_short ppf pbk
  | Originated h ->
      Contract_hash.pp_short ppf h

let encoding =
  let open Data_encoding in
  def
    "contract_id"
    ~title:"A contract handle"
    ~description:
      "A contract notation as given to an RPC or inside scripts. Can be a \
       base58 implicit contract hash or a base58 originated contract hash."
  @@ splitted
       ~binary:
         (union
            ~tag_size:`Uint8
            [ case
                (Tag 0)
                ~title:"Implicit"
                Signature.Public_key_hash.encoding
                (function Implicit k -> Some k | _ -> None)
                (fun k -> Implicit k);
              case
                (Tag 1)
                (Fixed.add_padding Contract_hash.encoding 1)
                ~title:"Originated"
                (function Originated k -> Some k | _ -> None)
                (fun k -> Originated k) ])
       ~json:
         (conv
            to_b58check
            (fun s ->
              match of_b58check s with
              | Ok s ->
                  s
              | Error _ ->
                  Json.cannot_destruct "Invalid contract notation.")
            string)

let () =
  let open Data_encoding in
  register_error_kind
    `Permanent
    ~id:"contract.invalid_contract_notation"
    ~title:"Invalid contract notation"
    ~pp:(fun ppf x -> Format.fprintf ppf "Invalid contract notation %S" x)
    ~description:
      "A malformed contract notation was given to an RPC or in a script."
    (obj1 (req "notation" string))
    (function Invalid_contract_notation loc -> Some loc | _ -> None)
    (fun loc -> Invalid_contract_notation loc)

let implicit_contract id = Implicit id

let is_implicit = function Implicit m -> Some m | Originated _ -> None

let is_originated = function Implicit _ -> None | Originated h -> Some h

type origination_nonce = {
  operation_hash : Operation_hash.t;
  origination_index : int32;
}

let origination_nonce_encoding =
  let open Data_encoding in
  conv
    (fun {operation_hash; origination_index} ->
      (operation_hash, origination_index))
    (fun (operation_hash, origination_index) ->
      {operation_hash; origination_index})
  @@ obj2 (req "operation" Operation_hash.encoding) (dft "index" int32 0l)

let originated_contract nonce =
  let data =
    Data_encoding.Binary.to_bytes_exn origination_nonce_encoding nonce
  in
  Originated (Contract_hash.hash_bytes [data])

let originated_contracts
    ~since:{origination_index = first; operation_hash = first_hash}
    ~until:( {origination_index = last; operation_hash = last_hash} as
           origination_nonce ) =
  assert (Operation_hash.equal first_hash last_hash) ;
  let rec contracts acc origination_index =
    if Compare.Int32.(origination_index < first) then acc
    else
      let origination_nonce = {origination_nonce with origination_index} in
      let acc = originated_contract origination_nonce :: acc in
      contracts acc (Int32.pred origination_index)
  in
  contracts [] (Int32.pred last)

let initial_origination_nonce operation_hash =
  {operation_hash; origination_index = 0l}

let incr_origination_nonce nonce =
  let origination_index = Int32.succ nonce.origination_index in
  {nonce with origination_index}

let rpc_arg =
  let construct = to_b58check in
  let destruct hash =
    match of_b58check hash with
    | Error _ ->
        Error "Cannot parse contract id"
    | Ok contract ->
        Ok contract
  in
  RPC_arg.make
    ~descr:"A contract identifier encoded in b58check."
    ~name:"contract_id"
    ~construct
    ~destruct
    ()

module Index = struct
  type t = contract

  let path_length = 7

  let to_path c l =
    let raw_key = Data_encoding.Binary.to_bytes_exn encoding c in
    let (`Hex key) = MBytes.to_hex raw_key in
    let (`Hex index_key) = MBytes.to_hex (Raw_hashes.blake2b raw_key) in
    String.sub index_key 0 2 :: String.sub index_key 2 2
    :: String.sub index_key 4 2 :: String.sub index_key 6 2
    :: String.sub index_key 8 2 :: String.sub index_key 10 2 :: key :: l

  let of_path = function
    | []
    | [_]
    | [_; _]
    | [_; _; _]
    | [_; _; _; _]
    | [_; _; _; _; _]
    | [_; _; _; _; _; _]
    | _ :: _ :: _ :: _ :: _ :: _ :: _ :: _ :: _ ->
        None
    | [index1; index2; index3; index4; index5; index6; key] ->
        let raw_key = MBytes.of_hex (`Hex key) in
        let (`Hex index_key) = MBytes.to_hex (Raw_hashes.blake2b raw_key) in
        assert (Compare.String.(String.sub index_key 0 2 = index1)) ;
        assert (Compare.String.(String.sub index_key 2 2 = index2)) ;
        assert (Compare.String.(String.sub index_key 4 2 = index3)) ;
        assert (Compare.String.(String.sub index_key 6 2 = index4)) ;
        assert (Compare.String.(String.sub index_key 8 2 = index5)) ;
        assert (Compare.String.(String.sub index_key 10 2 = index6)) ;
        Data_encoding.Binary.of_bytes encoding raw_key

  let rpc_arg = rpc_arg

  let encoding = encoding

  let compare = compare
end

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Inductive t : Set :=
| Implicit :
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t -> t
| Originated : Tezos_raw_protocol_alpha.Contract_hash.t -> t.

(* ❌ Cannot include this kind of module expression *)
include

Definition contract := t.

(* ❌ Structure item `typext` not handled. *)
type_extension

Definition to_b58check (function_parameter : t) : string :=
  match function_parameter with
  | Implicit pbk => Signature.Public_key_hash.to_b58check pbk
  | Originated h => Contract_hash.to_b58check h
  end.

Definition of_b58check (s : string)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult t :=
  match Base58.decode s with
  | Some (Tezos_protocol_environment_alpha__Environment.Base58.Data h) =>
    ok
      (Implicit
        (Tezos_protocol_environment_alpha__Environment.Signature.Ed25519 h))
  | Some (Tezos_protocol_environment_alpha__Environment.Base58.Data h) =>
    ok
      (Implicit
        (Tezos_protocol_environment_alpha__Environment.Signature.Secp256k1 h))
  | Some (Tezos_protocol_environment_alpha__Environment.Base58.Data h) =>
    ok
      (Implicit (Tezos_protocol_environment_alpha__Environment.Signature.P256 h))
  | Some (Tezos_protocol_environment_alpha__Environment.Base58.Data h) =>
    ok (Originated h)
  | _ =>
    __error_value
      (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_contract_notation
        s)
  end.

Definition pp
  (ppf : Tezos_protocol_environment_alpha__Environment.Format.formatter)
  (function_parameter : t) : unit :=
  match function_parameter with
  | Implicit pbk => Signature.Public_key_hash.pp ppf pbk
  | Originated h => Contract_hash.pp ppf h
  end.

Definition pp_short
  (ppf : Tezos_protocol_environment_alpha__Environment.Format.formatter)
  (function_parameter : t) : unit :=
  match function_parameter with
  | Implicit pbk => Signature.Public_key_hash.pp_short ppf pbk
  | Originated h => Contract_hash.pp_short ppf h
  end.

Definition encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding t :=
  op_atat
    (def "contract_id" % string (Some "A contract handle" % string)
      (Some
        "A contract notation as given to an RPC or inside scripts. Can be a base58 implicit contract hash or a base58 originated contract hash."
          % string))
    (splitted
      (conv to_b58check
        (fun s =>
          match of_b58check s with
          | Tezos_protocol_environment_alpha__Environment.Pervasives.Ok s => s
          | Tezos_protocol_environment_alpha__Environment.Pervasives.Error _ =>
            Json.cannot_destruct
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Invalid contract notation." % string
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
                "Invalid contract notation." % string)
          end) None __string_value)
      (union
        (Some
          (* ❌ Variants not supported *)
          variant)
        (cons
          (__case_value "Implicit" % string None
            (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag 0)
            Signature.Public_key_hash.encoding
            (fun function_parameter =>
              match function_parameter with
              | Implicit k => Some k
              | _ => None
              end) (fun k => Implicit k))
          (cons
            (__case_value "Originated" % string None
              (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag 1)
              (Fixed.add_padding Contract_hash.encoding 1)
              (fun function_parameter =>
                match function_parameter with
                | Originated k => Some k
                | _ => None
                end) (fun k => Originated k)) [])))).

(* ❌ Top-level evaluations are considered as an error as sources of side-effects *)
Compute
  register_error_kind
    (* ❌ Variants not supported *)
    variant "contract.invalid_contract_notation" % string
    "Invalid contract notation" % string
    "A malformed contract notation was given to an RPC or in a script." % string
    (Some
      (fun ppf =>
        fun x =>
          Format.fprintf ppf
            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                "Invalid contract notation " % string
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Caml_string
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format))
              "Invalid contract notation %S" % string) x))
    (obj1 (req None None "notation" % string __string_value))
    (fun function_parameter =>
      match function_parameter with
      |
        Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_contract_notation
          loc => Some loc
      | _ => None
      end)
    (fun loc =>
      Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_contract_notation
        loc).

Definition implicit_contract
  (id :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  : t := Implicit id.

Definition is_implicit (function_parameter : t)
  : option
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t :=
  match function_parameter with
  | Implicit m => Some m
  | Originated _ => None
  end.

Definition is_originated (function_parameter : t)
  : option Tezos_raw_protocol_alpha.Contract_hash.t :=
  match function_parameter with
  | Implicit _ => None
  | Originated h => Some h
  end.

Module origination_nonce.
  Record record := {
    operation_hash :
      Tezos_protocol_environment_alpha__Environment.Operation_hash.t;
    origination_index : int32 }.
End origination_nonce.
Definition origination_nonce := origination_nonce.record.

Definition origination_nonce_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    origination_nonce :=
  op_atat
    (let arg :=
      conv
        (fun function_parameter =>
          let '{|
            origination_nonce.operation_hash := operation_hash;
              origination_nonce.origination_index := origination_index
              |} := function_parameter in
          (operation_hash, origination_index))
        (fun function_parameter =>
          let '(operation_hash, origination_index) := function_parameter in
          {| origination_nonce.operation_hash := operation_hash;
            origination_nonce.origination_index := origination_index |}) in
    fun eta => arg None eta)
    (obj2 (req None None "operation" % string Operation_hash.encoding)
      (dft None None "index" % string __int32_value
        (* ❌ Constant of type int32 is converted to int *)
        0)).

Definition originated_contract (nonce : origination_nonce) : t :=
  let data := Data_encoding.Binary.to_bytes_exn origination_nonce_encoding nonce
    in
  Originated (Contract_hash.hash_bytes None (cons data [])).

Definition originated_contracts (function_parameter : origination_nonce)
  : origination_nonce -> list t :=
  let '{|
    origination_nonce.operation_hash := first_hash;
      origination_nonce.origination_index := first
      |} := function_parameter in
  fun function_parameter =>
    let
      '{|
        origination_nonce.operation_hash := last_hash;
          origination_nonce.origination_index := last
          |} as origination_nonce := function_parameter in
    (* ❌ Sequences of instructions are not handled (operator ";") *)
    let _ :=
      (* ❌ Assert instruction is not handled. *)
      assert (Operation_hash.equal first_hash last_hash) in
    let fix contracts
      (acc : list t) (origination_index :
      Tezos_protocol_environment_alpha__Environment.Compare.Int32.t) : list t :=
      if op_lt origination_index first then
        acc
      else
        let origination_nonce :=
          (* ❌ Record substitution not handled *)
          record_substitution in
        let acc := cons (originated_contract origination_nonce) acc in
        contracts acc (Int32.pred origination_index) in
    contracts [] (Int32.pred last).

Definition initial_origination_nonce
  (operation_hash :
    Tezos_protocol_environment_alpha__Environment.Operation_hash.t)
  : origination_nonce :=
  {| origination_nonce.operation_hash := operation_hash;
    origination_nonce.origination_index :=
      (* ❌ Constant of type int32 is converted to int *)
      0 |}.

Definition incr_origination_nonce (nonce : origination_nonce)
  : origination_nonce :=
  let origination_index :=
    Int32.succ (origination_nonce.origination_index nonce) in
  (* ❌ Record substitution not handled *)
  record_substitution.

Definition rpc_arg
  : Tezos_protocol_environment_alpha__Environment.RPC_arg.arg t :=
  let construct := to_b58check in
  let destruct (__hash_value : string)
    : Tezos_protocol_environment_alpha__Environment.Pervasives.result t string :=
    match of_b58check __hash_value with
    | Tezos_protocol_environment_alpha__Environment.Pervasives.Error _ =>
      Tezos_protocol_environment_alpha__Environment.Pervasives.Error
        "Cannot parse contract id" % string
    | Tezos_protocol_environment_alpha__Environment.Pervasives.Ok contract =>
      Tezos_protocol_environment_alpha__Environment.Pervasives.Ok contract
    end in
  RPC_arg.make (Some "A contract identifier encoded in b58check." % string)
    "contract_id" % string destruct construct tt.

Module Index.
  Definition t := contract.
  
  Definition path_length : Z := 7.
  
  Definition to_path (c : t) (l : list string) : list string :=
    let raw_key := Data_encoding.Binary.to_bytes_exn encoding c in
    let 'Hex key := MBytes.to_hex raw_key in
    let 'Hex index_key := MBytes.to_hex (Raw_hashes.blake2b raw_key) in
    cons (String.sub index_key 0 2)
      (cons (String.sub index_key 2 2)
        (cons (String.sub index_key 4 2)
          (cons (String.sub index_key 6 2)
            (cons (String.sub index_key 8 2)
              (cons (String.sub index_key 10 2) (cons key l)))))).
  
  Definition of_path
    (function_parameter :
      list Tezos_protocol_environment_alpha__Environment.Compare.String.t)
    : option t :=
    match function_parameter with
    |
      [] | cons _ [] | cons _ (cons _ []) | cons _ (cons _ (cons _ [])) |
        cons _ (cons _ (cons _ (cons _ []))) |
        cons _ (cons _ (cons _ (cons _ (cons _ [])))) |
        cons _ (cons _ (cons _ (cons _ (cons _ (cons _ []))))) |
        cons _ (cons _ (cons _ (cons _ (cons _ (cons _ (cons _ (cons _ _)))))))
      => None
    |
      cons index1
        (cons index2
          (cons index3 (cons index4 (cons index5 (cons index6 (cons key []))))))
      =>
      let raw_key :=
        MBytes.of_hex
          (* ❌ Variants not supported *)
          variant in
      let 'Hex index_key := MBytes.to_hex (Raw_hashes.blake2b raw_key) in
      (* ❌ Sequences of instructions are not handled (operator ";") *)
      let _ :=
        (* ❌ Assert instruction is not handled. *)
        assert (op_eq (String.sub index_key 0 2) index1) in
      (* ❌ Sequences of instructions are not handled (operator ";") *)
      let _ :=
        (* ❌ Assert instruction is not handled. *)
        assert (op_eq (String.sub index_key 2 2) index2) in
      (* ❌ Sequences of instructions are not handled (operator ";") *)
      let _ :=
        (* ❌ Assert instruction is not handled. *)
        assert (op_eq (String.sub index_key 4 2) index3) in
      (* ❌ Sequences of instructions are not handled (operator ";") *)
      let _ :=
        (* ❌ Assert instruction is not handled. *)
        assert (op_eq (String.sub index_key 6 2) index4) in
      (* ❌ Sequences of instructions are not handled (operator ";") *)
      let _ :=
        (* ❌ Assert instruction is not handled. *)
        assert (op_eq (String.sub index_key 8 2) index5) in
      (* ❌ Sequences of instructions are not handled (operator ";") *)
      let _ :=
        (* ❌ Assert instruction is not handled. *)
        assert (op_eq (String.sub index_key 10 2) index6) in
      Data_encoding.Binary.of_bytes encoding raw_key
    end.
  
  Definition rpc_arg
    : Tezos_protocol_environment_alpha__Environment.RPC_arg.arg t := rpc_arg.
  
  Definition encoding
    : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding t :=
    encoding.
  
  Definition compare : t -> t -> Z := compare.
End Index.

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

type t = private
  | Implicit of Signature.Public_key_hash.t
  | Originated of Contract_hash.t

type contract = t

include Compare.S with type t := contract

(** {2 Implicit contracts} *)

val implicit_contract : Signature.Public_key_hash.t -> contract

val is_implicit : contract -> Signature.Public_key_hash.t option

(** {2 Originated contracts} *)

(** Originated contracts handles are crafted from the hash of the
    operation that triggered their origination (and nothing else).
    As a single operation can trigger several originations, the
    corresponding handles are forged from a deterministic sequence of
    nonces, initialized with the hash of the operation. *)
type origination_nonce

val originated_contract : origination_nonce -> contract

val originated_contracts :
  since:origination_nonce -> until:origination_nonce -> contract list

val initial_origination_nonce : Operation_hash.t -> origination_nonce

val incr_origination_nonce : origination_nonce -> origination_nonce

val is_originated : contract -> Contract_hash.t option

(** {2 Human readable notation} *)

type error += Invalid_contract_notation of string (* `Permanent *)

val to_b58check : contract -> string

val of_b58check : string -> contract tzresult

val pp : Format.formatter -> contract -> unit

val pp_short : Format.formatter -> contract -> unit

(** {2 Serializers} *)

val encoding : contract Data_encoding.t

val origination_nonce_encoding : origination_nonce Data_encoding.t

val rpc_arg : contract RPC_arg.arg

module Index : Storage_description.INDEX with type t = t

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Inductive t : Set :=
| Implicit :
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t -> t
| Originated : Tezos_raw_protocol_alpha.Contract_hash.t -> t.

Definition contract := t.

Parameter op_eq : contract -> contract -> bool.

Parameter op_ltgt : contract -> contract -> bool.

Parameter op_lt : contract -> contract -> bool.

Parameter op_lteq : contract -> contract -> bool.

Parameter op_gteq : contract -> contract -> bool.

Parameter op_gt : contract -> contract -> bool.

Parameter compare : contract -> contract -> Z.

Parameter equal : contract -> contract -> bool.

Parameter max : contract -> contract -> contract.

Parameter min : contract -> contract -> contract.

Parameter implicit_contract :
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  contract.

Parameter is_implicit :
  contract ->
  option
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t.

Parameter origination_nonce : Set.

Parameter originated_contract : origination_nonce -> contract.

Parameter originated_contracts :
  origination_nonce -> origination_nonce -> list contract.

Parameter initial_origination_nonce :
  Tezos_protocol_environment_alpha__Environment.Operation_hash.t ->
  origination_nonce.

Parameter incr_origination_nonce : origination_nonce -> origination_nonce.

Parameter is_originated :
  contract -> option Tezos_raw_protocol_alpha.Contract_hash.t.

(* extensible_type Tezos_protocol_environment_alpha__Environment.Error_monad.error *)

Parameter to_b58check : contract -> string.

Parameter of_b58check :
  string ->
  Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult contract.

Parameter pp :
  Tezos_protocol_environment_alpha__Environment.Format.formatter -> contract ->
  unit.

Parameter pp_short :
  Tezos_protocol_environment_alpha__Environment.Format.formatter -> contract ->
  unit.

Parameter encoding :
  Tezos_protocol_environment_alpha__Environment.Data_encoding.t contract.

Parameter origination_nonce_encoding :
  Tezos_protocol_environment_alpha__Environment.Data_encoding.t
    origination_nonce.

Parameter rpc_arg :
  Tezos_protocol_environment_alpha__Environment.RPC_arg.arg contract.

Module Index.
  Definition t := t.
  
  Parameter path_length : Z.
  
  Parameter to_path : t -> list string -> list string.
  
  Parameter of_path : list string -> option t.
  
  Parameter rpc_arg : Tezos_protocol_environment_alpha__Environment.RPC_arg.t t.
  
  Parameter encoding :
    Tezos_protocol_environment_alpha__Environment.Data_encoding.t t.
  
  Parameter compare : t -> t -> Z.
End Index.

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Alpha_context

let custom_root =
  ( RPC_path.(open_root / "context" / "contracts")
    : RPC_context.t RPC_path.context )

let big_map_root =
  ( RPC_path.(open_root / "context" / "big_maps")
    : RPC_context.t RPC_path.context )

type info = {
  balance : Tez.t;
  delegate : public_key_hash option;
  counter : counter option;
  script : Script.t option;
}

let info_encoding =
  let open Data_encoding in
  conv
    (fun {balance; delegate; script; counter} ->
      (balance, delegate, script, counter))
    (fun (balance, delegate, script, counter) ->
      {balance; delegate; script; counter})
  @@ obj4
       (req "balance" Tez.encoding)
       (opt "delegate" Signature.Public_key_hash.encoding)
       (opt "script" Script.encoding)
       (opt "counter" n)

module S = struct
  open Data_encoding

  let balance =
    RPC_service.get_service
      ~description:"Access the balance of a contract."
      ~query:RPC_query.empty
      ~output:Tez.encoding
      RPC_path.(custom_root /: Contract.rpc_arg / "balance")

  let manager_key =
    RPC_service.get_service
      ~description:"Access the manager of a contract."
      ~query:RPC_query.empty
      ~output:(option Signature.Public_key.encoding)
      RPC_path.(custom_root /: Contract.rpc_arg / "manager_key")

  let delegate =
    RPC_service.get_service
      ~description:"Access the delegate of a contract, if any."
      ~query:RPC_query.empty
      ~output:Signature.Public_key_hash.encoding
      RPC_path.(custom_root /: Contract.rpc_arg / "delegate")

  let counter =
    RPC_service.get_service
      ~description:"Access the counter of a contract, if any."
      ~query:RPC_query.empty
      ~output:z
      RPC_path.(custom_root /: Contract.rpc_arg / "counter")

  let script =
    RPC_service.get_service
      ~description:"Access the code and data of the contract."
      ~query:RPC_query.empty
      ~output:Script.encoding
      RPC_path.(custom_root /: Contract.rpc_arg / "script")

  let storage =
    RPC_service.get_service
      ~description:"Access the data of the contract."
      ~query:RPC_query.empty
      ~output:Script.expr_encoding
      RPC_path.(custom_root /: Contract.rpc_arg / "storage")

  let entrypoint_type =
    RPC_service.get_service
      ~description:"Return the type of the given entrypoint of the contract"
      ~query:RPC_query.empty
      ~output:Script.expr_encoding
      RPC_path.(
        custom_root /: Contract.rpc_arg / "entrypoints" /: RPC_arg.string)

  let list_entrypoints =
    RPC_service.get_service
      ~description:"Return the list of entrypoints of the contract"
      ~query:RPC_query.empty
      ~output:
        (obj2
           (dft
              "unreachable"
              (Data_encoding.list
                 (obj1
                    (req
                       "path"
                       (Data_encoding.list
                          Michelson_v1_primitives.prim_encoding))))
              [])
           (req "entrypoints" (assoc Script.expr_encoding)))
      RPC_path.(custom_root /: Contract.rpc_arg / "entrypoints")

  let contract_big_map_get_opt =
    RPC_service.post_service
      ~description:
        "Access the value associated with a key in a big map of the contract \
         (deprecated)."
      ~query:RPC_query.empty
      ~input:
        (obj2
           (req "key" Script.expr_encoding)
           (req "type" Script.expr_encoding))
      ~output:(option Script.expr_encoding)
      RPC_path.(custom_root /: Contract.rpc_arg / "big_map_get")

  let big_map_get =
    RPC_service.get_service
      ~description:"Access the value associated with a key in a big map."
      ~query:RPC_query.empty
      ~output:Script.expr_encoding
      RPC_path.(big_map_root /: Big_map.rpc_arg /: Script_expr_hash.rpc_arg)

  let info =
    RPC_service.get_service
      ~description:"Access the complete status of a contract."
      ~query:RPC_query.empty
      ~output:info_encoding
      RPC_path.(custom_root /: Contract.rpc_arg)

  let list =
    RPC_service.get_service
      ~description:
        "All existing contracts (including non-empty default contracts)."
      ~query:RPC_query.empty
      ~output:(list Contract.encoding)
      custom_root
end

let register () =
  let open Services_registration in
  register0 S.list (fun ctxt () () -> Contract.list ctxt >>= return) ;
  let register_field s f =
    register1 s (fun ctxt contract () () ->
        Contract.exists ctxt contract
        >>=? function true -> f ctxt contract | false -> raise Not_found)
  in
  let register_opt_field s f =
    register_field s (fun ctxt a1 ->
        f ctxt a1 >>=? function None -> raise Not_found | Some v -> return v)
  in
  let do_big_map_get ctxt id key =
    let open Script_ir_translator in
    let ctxt = Gas.set_unlimited ctxt in
    Big_map.exists ctxt id
    >>=? fun (ctxt, types) ->
    match types with
    | None ->
        raise Not_found
    | Some (_, value_type) -> (
        Lwt.return
          (parse_ty
             ctxt
             ~legacy:true
             ~allow_big_map:false
             ~allow_operation:false
             ~allow_contract:true
             (Micheline.root value_type))
        >>=? fun (Ex_ty value_type, ctxt) ->
        Big_map.get_opt ctxt id key
        >>=? fun (_ctxt, value) ->
        match value with
        | None ->
            raise Not_found
        | Some value ->
            parse_data ctxt ~legacy:true value_type (Micheline.root value)
            >>=? fun (value, ctxt) ->
            unparse_data ctxt Readable value_type value
            >>=? fun (value, _ctxt) -> return (Micheline.strip_locations value)
        )
  in
  register_field S.balance Contract.get_balance ;
  register1 S.manager_key (fun ctxt contract () () ->
      match Contract.is_implicit contract with
      | None ->
          raise Not_found
      | Some mgr -> (
          Contract.is_manager_key_revealed ctxt mgr
          >>=? function
          | false ->
              return_none
          | true ->
              Contract.get_manager_key ctxt mgr >>=? return_some )) ;
  register_opt_field S.delegate Delegate.get ;
  register1 S.counter (fun ctxt contract () () ->
      match Contract.is_implicit contract with
      | None ->
          raise Not_found
      | Some mgr ->
          Contract.get_counter ctxt mgr) ;
  register_opt_field S.script (fun c v ->
      Contract.get_script c v >>=? fun (_, v) -> return v) ;
  register_opt_field S.storage (fun ctxt contract ->
      Contract.get_script ctxt contract
      >>=? fun (ctxt, script) ->
      match script with
      | None ->
          return_none
      | Some script ->
          let ctxt = Gas.set_unlimited ctxt in
          let open Script_ir_translator in
          parse_script ctxt ~legacy:true script
          >>=? fun (Ex_script script, ctxt) ->
          unparse_script ctxt Readable script
          >>=? fun (script, ctxt) ->
          Script.force_decode ctxt script.storage
          >>=? fun (storage, _ctxt) -> return_some storage) ;
  register2 S.entrypoint_type (fun ctxt v entrypoint () () ->
      Contract.get_script_code ctxt v
      >>=? fun (_, expr) ->
      match expr with
      | None ->
          raise Not_found
      | Some expr -> (
          let ctxt = Gas.set_unlimited ctxt in
          let legacy = true in
          let open Script_ir_translator in
          Script.force_decode ctxt expr
          >>=? fun (expr, _) ->
          Lwt.return
            ( parse_toplevel ~legacy expr
            >>? fun (arg_type, _, _, root_name) ->
            parse_ty
              ctxt
              ~legacy
              ~allow_big_map:true
              ~allow_operation:false
              ~allow_contract:true
              arg_type
            >>? fun (Ex_ty arg_type, _) ->
            Script_ir_translator.find_entrypoint ~root_name arg_type entrypoint
            )
          >>= function
          | Ok (_f, Ex_ty ty) ->
              unparse_ty ctxt ty
              >>=? fun (ty_node, _) ->
              return (Micheline.strip_locations ty_node)
          | Error _ ->
              raise Not_found )) ;
  register1 S.list_entrypoints (fun ctxt v () () ->
      Contract.get_script_code ctxt v
      >>=? fun (_, expr) ->
      match expr with
      | None ->
          raise Not_found
      | Some expr ->
          let ctxt = Gas.set_unlimited ctxt in
          let legacy = true in
          let open Script_ir_translator in
          Script.force_decode ctxt expr
          >>=? fun (expr, _) ->
          Lwt.return
            ( parse_toplevel ~legacy expr
            >>? fun (arg_type, _, _, root_name) ->
            parse_ty
              ctxt
              ~legacy
              ~allow_big_map:true
              ~allow_operation:false
              ~allow_contract:true
              arg_type
            >>? fun (Ex_ty arg_type, _) ->
            Script_ir_translator.list_entrypoints ~root_name arg_type ctxt )
          >>=? fun (unreachable_entrypoint, map) ->
          return
            ( unreachable_entrypoint,
              Entrypoints_map.fold
                (fun entry (_, ty) acc ->
                  (entry, Micheline.strip_locations ty) :: acc)
                map
                [] )) ;
  register1 S.contract_big_map_get_opt (fun ctxt contract () (key, key_type) ->
      Contract.get_script ctxt contract
      >>=? fun (ctxt, script) ->
      Lwt.return
        (Script_ir_translator.parse_packable_ty
           ctxt
           ~legacy:true
           (Micheline.root key_type))
      >>=? fun (Ex_ty key_type, ctxt) ->
      Script_ir_translator.parse_data
        ctxt
        ~legacy:true
        key_type
        (Micheline.root key)
      >>=? fun (key, ctxt) ->
      Script_ir_translator.hash_data ctxt key_type key
      >>=? fun (key, ctxt) ->
      match script with
      | None ->
          raise Not_found
      | Some script ->
          let ctxt = Gas.set_unlimited ctxt in
          let open Script_ir_translator in
          parse_script ctxt ~legacy:true script
          >>=? fun (Ex_script script, ctxt) ->
          Script_ir_translator.collect_big_maps
            ctxt
            script.storage_type
            script.storage
          >>=? fun (ids, _ctxt) ->
          let ids = Script_ir_translator.list_of_big_map_ids ids in
          let rec find = function
            | [] ->
                return_none
            | (id : Z.t) :: ids -> (
              try do_big_map_get ctxt id key >>=? return_some
              with Not_found -> find ids )
          in
          find ids) ;
  register2 S.big_map_get (fun ctxt id key () () -> do_big_map_get ctxt id key) ;
  register_field S.info (fun ctxt contract ->
      Contract.get_balance ctxt contract
      >>=? fun balance ->
      Delegate.get ctxt contract
      >>=? fun delegate ->
      ( match Contract.is_implicit contract with
      | Some manager ->
          Contract.get_counter ctxt manager
          >>=? fun counter -> return_some counter
      | None ->
          return None )
      >>=? fun counter ->
      Contract.get_script ctxt contract
      >>=? fun (ctxt, script) ->
      ( match script with
      | None ->
          return (None, ctxt)
      | Some script ->
          let ctxt = Gas.set_unlimited ctxt in
          let open Script_ir_translator in
          parse_script ctxt ~legacy:true script
          >>=? fun (Ex_script script, ctxt) ->
          unparse_script ctxt Readable script
          >>=? fun (script, ctxt) -> return (Some script, ctxt) )
      >>=? fun (script, _ctxt) -> return {balance; delegate; script; counter})

let list ctxt block = RPC_context.make_call0 S.list ctxt block () ()

let info ctxt block contract =
  RPC_context.make_call1 S.info ctxt block contract () ()

let balance ctxt block contract =
  RPC_context.make_call1 S.balance ctxt block contract () ()

let manager_key ctxt block mgr =
  RPC_context.make_call1
    S.manager_key
    ctxt
    block
    (Contract.implicit_contract mgr)
    ()
    ()

let delegate ctxt block contract =
  RPC_context.make_call1 S.delegate ctxt block contract () ()

let delegate_opt ctxt block contract =
  RPC_context.make_opt_call1 S.delegate ctxt block contract () ()

let counter ctxt block mgr =
  RPC_context.make_call1
    S.counter
    ctxt
    block
    (Contract.implicit_contract mgr)
    ()
    ()

let script ctxt block contract =
  RPC_context.make_call1 S.script ctxt block contract () ()

let script_opt ctxt block contract =
  RPC_context.make_opt_call1 S.script ctxt block contract () ()

let storage ctxt block contract =
  RPC_context.make_call1 S.storage ctxt block contract () ()

let entrypoint_type ctxt block contract entrypoint =
  RPC_context.make_call2 S.entrypoint_type ctxt block contract entrypoint () ()

let list_entrypoints ctxt block contract =
  RPC_context.make_call1 S.list_entrypoints ctxt block contract () ()

let storage_opt ctxt block contract =
  RPC_context.make_opt_call1 S.storage ctxt block contract () ()

let big_map_get ctxt block id key =
  RPC_context.make_call2 S.big_map_get ctxt block id key () ()

let contract_big_map_get_opt ctxt block contract key =
  RPC_context.make_call1 S.contract_big_map_get_opt ctxt block contract () key

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Import Alpha_context.

Definition custom_root
  : Tezos_protocol_environment_alpha__Environment.RPC_path.context
    Tezos_protocol_environment_alpha__Environment.RPC_context.t :=
  op_div (op_div open_root "context" % string) "contracts" % string.

Definition big_map_root
  : Tezos_protocol_environment_alpha__Environment.RPC_path.context
    Tezos_protocol_environment_alpha__Environment.RPC_context.t :=
  op_div (op_div open_root "context" % string) "big_maps" % string.

Module info.
  Record record := {
    balance : Tezos_raw_protocol_alpha.Alpha_context.Tez.t;
    delegate : option Tezos_raw_protocol_alpha.Alpha_context.public_key_hash;
    counter : option Tezos_raw_protocol_alpha.Alpha_context.counter;
    script : option Tezos_raw_protocol_alpha.Alpha_context.Script.t }.
End info.
Definition info := info.record.

Definition info_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding info :=
  op_atat
    (let arg :=
      conv
        (fun function_parameter =>
          let '{|
            info.balance := balance;
              info.delegate := delegate;
              info.counter := counter;
              info.script := script
              |} := function_parameter in
          (balance, delegate, script, counter))
        (fun function_parameter =>
          let '(balance, delegate, script, counter) := function_parameter in
          {| info.balance := balance; info.delegate := delegate;
            info.counter := counter; info.script := script |}) in
    fun eta => arg None eta)
    (obj4 (req None None "balance" % string Tez.encoding)
      (opt None None "delegate" % string Signature.Public_key_hash.encoding)
      (opt None None "script" % string Script.encoding)
      (opt None None "counter" % string n)).

Module S.
  Import Data_encoding.
  
  Definition balance
    : Tezos_protocol_environment_alpha__Environment.RPC_service.service
      (* `GET *) unit
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      (Tezos_protocol_environment_alpha__Environment.RPC_context.t *
        Tezos_raw_protocol_alpha.Alpha_context.Contract.contract) unit unit
      Tezos_raw_protocol_alpha.Alpha_context.Tez.t :=
    RPC_service.get_service (Some "Access the balance of a contract." % string)
      RPC_query.empty Tez.encoding
      (op_div (op_divcolon custom_root Contract.rpc_arg) "balance" % string).
  
  Definition manager_key
    : Tezos_protocol_environment_alpha__Environment.RPC_service.service
      (* `GET *) unit
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      (Tezos_protocol_environment_alpha__Environment.RPC_context.t *
        Tezos_raw_protocol_alpha.Alpha_context.Contract.contract) unit unit
      (option
        Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t) :=
    RPC_service.get_service (Some "Access the manager of a contract." % string)
      RPC_query.empty (__option_value Signature.Public_key.encoding)
      (op_div (op_divcolon custom_root Contract.rpc_arg) "manager_key" % string).
  
  Definition delegate
    : Tezos_protocol_environment_alpha__Environment.RPC_service.service
      (* `GET *) unit
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      (Tezos_protocol_environment_alpha__Environment.RPC_context.t *
        Tezos_raw_protocol_alpha.Alpha_context.Contract.contract) unit unit
      Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t :=
    RPC_service.get_service
      (Some "Access the delegate of a contract, if any." % string)
      RPC_query.empty Signature.Public_key_hash.encoding
      (op_div (op_divcolon custom_root Contract.rpc_arg) "delegate" % string).
  
  Definition counter
    : Tezos_protocol_environment_alpha__Environment.RPC_service.service
      (* `GET *) unit
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      (Tezos_protocol_environment_alpha__Environment.RPC_context.t *
        Tezos_raw_protocol_alpha.Alpha_context.Contract.contract) unit unit
      Tezos_protocol_environment_alpha__Environment.Z.t :=
    RPC_service.get_service
      (Some "Access the counter of a contract, if any." % string)
      RPC_query.empty z
      (op_div (op_divcolon custom_root Contract.rpc_arg) "counter" % string).
  
  Definition script
    : Tezos_protocol_environment_alpha__Environment.RPC_service.service
      (* `GET *) unit
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      (Tezos_protocol_environment_alpha__Environment.RPC_context.t *
        Tezos_raw_protocol_alpha.Alpha_context.Contract.contract) unit unit
      Tezos_raw_protocol_alpha.Alpha_context.Script.t :=
    RPC_service.get_service
      (Some "Access the code and data of the contract." % string)
      RPC_query.empty Script.encoding
      (op_div (op_divcolon custom_root Contract.rpc_arg) "script" % string).
  
  Definition storage
    : Tezos_protocol_environment_alpha__Environment.RPC_service.service
      (* `GET *) unit
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      (Tezos_protocol_environment_alpha__Environment.RPC_context.t *
        Tezos_raw_protocol_alpha.Alpha_context.Contract.contract) unit unit
      Tezos_raw_protocol_alpha.Alpha_context.Script.expr :=
    RPC_service.get_service (Some "Access the data of the contract." % string)
      RPC_query.empty Script.expr_encoding
      (op_div (op_divcolon custom_root Contract.rpc_arg) "storage" % string).
  
  Definition entrypoint_type
    : Tezos_protocol_environment_alpha__Environment.RPC_service.service
      (* `GET *) unit
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      ((Tezos_protocol_environment_alpha__Environment.RPC_context.t *
        Tezos_raw_protocol_alpha.Alpha_context.Contract.contract) * string) unit
      unit Tezos_raw_protocol_alpha.Alpha_context.Script.expr :=
    RPC_service.get_service
      (Some "Return the type of the given entrypoint of the contract" % string)
      RPC_query.empty Script.expr_encoding
      (op_divcolon
        (op_div (op_divcolon custom_root Contract.rpc_arg)
          "entrypoints" % string) RPC_arg.__string_value).
  
  Definition list_entrypoints
    : Tezos_protocol_environment_alpha__Environment.RPC_service.service
      (* `GET *) unit
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      (Tezos_protocol_environment_alpha__Environment.RPC_context.t *
        Tezos_raw_protocol_alpha.Alpha_context.Contract.contract) unit unit
      (list (list Tezos_raw_protocol_alpha.Michelson_v1_primitives.prim) *
        list (string * Tezos_raw_protocol_alpha.Alpha_context.Script.expr)) :=
    RPC_service.get_service
      (Some "Return the list of entrypoints of the contract" % string)
      RPC_query.empty
      (obj2
        (dft None None "unreachable" % string
          (Data_encoding.__list_value None
            (obj1
              (req None None "path" % string
                (Data_encoding.__list_value None
                  Michelson_v1_primitives.prim_encoding)))) [])
        (req None None "entrypoints" % string (assoc Script.expr_encoding)))
      (op_div (op_divcolon custom_root Contract.rpc_arg) "entrypoints" % string).
  
  Definition contract_big_map_get_opt
    : Tezos_protocol_environment_alpha__Environment.RPC_service.service
      (* `POST *) unit
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      (Tezos_protocol_environment_alpha__Environment.RPC_context.t *
        Tezos_raw_protocol_alpha.Alpha_context.Contract.contract) unit
      (Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
        Tezos_raw_protocol_alpha.Alpha_context.Script.expr)
      (option Tezos_raw_protocol_alpha.Alpha_context.Script.expr) :=
    RPC_service.post_service
      (Some
        "Access the value associated with a key in a big map of the contract (deprecated)."
          % string) RPC_query.empty
      (obj2 (req None None "key" % string Script.expr_encoding)
        (req None None "type" % string Script.expr_encoding))
      (__option_value Script.expr_encoding)
      (op_div (op_divcolon custom_root Contract.rpc_arg) "big_map_get" % string).
  
  Definition big_map_get
    : Tezos_protocol_environment_alpha__Environment.RPC_service.service
      (* `GET *) unit
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      ((Tezos_protocol_environment_alpha__Environment.RPC_context.t *
        Tezos_raw_protocol_alpha.Alpha_context.Big_map.id) *
        Tezos_raw_protocol_alpha.Script_expr_hash.t) unit unit
      Tezos_raw_protocol_alpha.Alpha_context.Script.expr :=
    RPC_service.get_service
      (Some "Access the value associated with a key in a big map." % string)
      RPC_query.empty Script.expr_encoding
      (op_divcolon (op_divcolon big_map_root Big_map.rpc_arg)
        Script_expr_hash.rpc_arg).
  
  Definition info
    : Tezos_protocol_environment_alpha__Environment.RPC_service.service
      (* `GET *) unit
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      (Tezos_protocol_environment_alpha__Environment.RPC_context.t *
        Tezos_raw_protocol_alpha.Alpha_context.Contract.contract) unit unit info :=
    RPC_service.get_service
      (Some "Access the complete status of a contract." % string)
      RPC_query.empty info_encoding (op_divcolon custom_root Contract.rpc_arg).
  
  Definition __list_value
    : Tezos_protocol_environment_alpha__Environment.RPC_service.service
      (* `GET *) unit
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t unit unit
      (list Tezos_raw_protocol_alpha.Alpha_context.Contract.t) :=
    RPC_service.get_service
      (Some
        "All existing contracts (including non-empty default contracts)." %
          string) RPC_query.empty (__list_value None Contract.encoding)
      custom_root.
End S.

Definition register (function_parameter : unit) : unit :=
  let 'tt := function_parameter in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register0 S.__list_value
      (fun ctxt =>
        fun function_parameter =>
          let 'tt := function_parameter in
          fun function_parameter =>
            let 'tt := function_parameter in
            op_gtgteq (Contract.__list_value ctxt) __return) in
  let register_field {A : Set}
    (s :
    Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
        (* `POST *) unit + (* `PUT *) unit)
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
      (Tezos_protocol_environment_alpha__Environment.Updater.rpc_context *
        Tezos_raw_protocol_alpha.Alpha_context.Contract.contract) unit unit A)
    (f :
    Tezos_raw_protocol_alpha.Alpha_context.t ->
    Tezos_raw_protocol_alpha.Alpha_context.Contract.contract ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult A))
    : unit :=
    register1 s
      (fun ctxt =>
        fun contract =>
          fun function_parameter =>
            let 'tt := function_parameter in
            fun function_parameter =>
              let 'tt := function_parameter in
              op_gtgteqquestion (Contract.__exists ctxt contract)
                (fun function_parameter =>
                  match function_parameter with
                  | true => f ctxt contract
                  | false => raise OCaml.Not_found
                  end)) in
  let register_opt_field {A : Set}
    (s :
    Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
        (* `POST *) unit + (* `PUT *) unit)
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
      (Tezos_protocol_environment_alpha__Environment.Updater.rpc_context *
        Tezos_raw_protocol_alpha.Alpha_context.Contract.contract) unit unit A)
    (f :
    Tezos_raw_protocol_alpha.Alpha_context.t ->
    Tezos_raw_protocol_alpha.Alpha_context.Contract.contract ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (option A))) : unit :=
    register_field s
      (fun ctxt =>
        fun a1 =>
          op_gtgteqquestion (f ctxt a1)
            (fun function_parameter =>
              match function_parameter with
              | None => raise OCaml.Not_found
              | Some v => __return v
              end)) in
  let do_big_map_get
    (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context) (id :
    Tezos_raw_protocol_alpha.Alpha_context.Big_map.id) (key :
    Tezos_raw_protocol_alpha.Script_expr_hash.t)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (Tezos_protocol_environment_alpha__Environment.Micheline.canonical
          Tezos_raw_protocol_alpha.Alpha_context.Script.prim)) :=
    let ctxt := Gas.set_unlimited ctxt in
    op_gtgteqquestion (Big_map.__exists ctxt id)
      (fun function_parameter =>
        let '(ctxt, types) := function_parameter in
        match types with
        | None => raise OCaml.Not_found
        | Some (_, value_type) =>
          op_gtgteqquestion
            (Lwt.__return
              (parse_ty ctxt true false false true (Micheline.root value_type)))
            (fun function_parameter =>
              let
                '(Tezos_raw_protocol_alpha.Script_ir_translator.Ex_ty value_type,
                  ctxt) := function_parameter in
              op_gtgteqquestion (Big_map.get_opt ctxt id key)
                (fun function_parameter =>
                  let '(_ctxt, value) := function_parameter in
                  match value with
                  | None => raise OCaml.Not_found
                  | Some value =>
                    op_gtgteqquestion
                      (parse_data None ctxt true value_type
                        (Micheline.root value))
                      (fun function_parameter =>
                        let '(value, ctxt) := function_parameter in
                        op_gtgteqquestion
                          (unparse_data ctxt
                            Tezos_raw_protocol_alpha.Script_ir_translator.Readable
                            value_type value)
                          (fun function_parameter =>
                            let '(value, _ctxt) := function_parameter in
                            __return (Micheline.strip_locations value)))
                  end))
        end) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ := register_field S.balance Contract.get_balance in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register1 S.manager_key
      (fun ctxt =>
        fun contract =>
          fun function_parameter =>
            let 'tt := function_parameter in
            fun function_parameter =>
              let 'tt := function_parameter in
              match Contract.is_implicit contract with
              | None => raise OCaml.Not_found
              | Some mgr =>
                op_gtgteqquestion (Contract.is_manager_key_revealed ctxt mgr)
                  (fun function_parameter =>
                    match function_parameter with
                    | false => return_none
                    | true =>
                      op_gtgteqquestion (Contract.get_manager_key ctxt mgr)
                        return_some
                    end)
              end) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ := register_opt_field S.delegate Delegate.get in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register1 S.counter
      (fun ctxt =>
        fun contract =>
          fun function_parameter =>
            let 'tt := function_parameter in
            fun function_parameter =>
              let 'tt := function_parameter in
              match Contract.is_implicit contract with
              | None => raise OCaml.Not_found
              | Some mgr => Contract.get_counter ctxt mgr
              end) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_opt_field S.script
      (fun c =>
        fun v =>
          op_gtgteqquestion (Contract.get_script c v)
            (fun function_parameter =>
              let '(_, v) := function_parameter in
              __return v)) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_opt_field S.storage
      (fun ctxt =>
        fun contract =>
          op_gtgteqquestion (Contract.get_script ctxt contract)
            (fun function_parameter =>
              let '(ctxt, script) := function_parameter in
              match script with
              | None => return_none
              | Some script =>
                let ctxt := Gas.set_unlimited ctxt in
                op_gtgteqquestion (parse_script None ctxt true script)
                  (fun function_parameter =>
                    let
                      '(Tezos_raw_protocol_alpha.Script_ir_translator.Ex_script
                        script, ctxt) := function_parameter in
                    op_gtgteqquestion
                      (unparse_script ctxt
                        Tezos_raw_protocol_alpha.Script_ir_translator.Readable
                        script)
                      (fun function_parameter =>
                        let '(script, ctxt) := function_parameter in
                        op_gtgteqquestion
                          (Script.force_decode ctxt
                            (Tezos_raw_protocol_alpha.Alpha_context.Script.t.storage
                              script))
                          (fun function_parameter =>
                            let '(storage, _ctxt) := function_parameter in
                            return_some storage)))
              end)) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register2 S.entrypoint_type
      (fun ctxt =>
        fun v =>
          fun entrypoint =>
            fun function_parameter =>
              let 'tt := function_parameter in
              fun function_parameter =>
                let 'tt := function_parameter in
                op_gtgteqquestion (Contract.get_script_code ctxt v)
                  (fun function_parameter =>
                    let '(_, expr) := function_parameter in
                    match expr with
                    | None => raise OCaml.Not_found
                    | Some expr =>
                      let ctxt := Gas.set_unlimited ctxt in
                      let legacy := true in
                      op_gtgteqquestion (Script.force_decode ctxt expr)
                        (fun function_parameter =>
                          let '(expr, _) := function_parameter in
                          op_gtgteq
                            (Lwt.__return
                              (op_gtgtquestion (parse_toplevel legacy expr)
                                (fun function_parameter =>
                                  let '(arg_type, _, _, root_name) :=
                                    function_parameter in
                                  op_gtgtquestion
                                    (parse_ty ctxt legacy true false true
                                      arg_type)
                                    (fun function_parameter =>
                                      let
                                        '(Tezos_raw_protocol_alpha.Script_ir_translator.Ex_ty
                                          arg_type, _) := function_parameter in
                                      Script_ir_translator.find_entrypoint
                                        arg_type root_name entrypoint))))
                            (fun function_parameter =>
                              match function_parameter with
                              |
                                Tezos_protocol_environment_alpha__Environment.Pervasives.Ok
                                  (_f,
                                    Tezos_raw_protocol_alpha.Script_ir_translator.Ex_ty
                                      ty) =>
                                op_gtgteqquestion (unparse_ty ctxt ty)
                                  (fun function_parameter =>
                                    let '(ty_node, _) := function_parameter in
                                    __return (Micheline.strip_locations ty_node))
                              |
                                Tezos_protocol_environment_alpha__Environment.Pervasives.Error
                                  _ => raise OCaml.Not_found
                              end))
                    end)) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register1 S.list_entrypoints
      (fun ctxt =>
        fun v =>
          fun function_parameter =>
            let 'tt := function_parameter in
            fun function_parameter =>
              let 'tt := function_parameter in
              op_gtgteqquestion (Contract.get_script_code ctxt v)
                (fun function_parameter =>
                  let '(_, expr) := function_parameter in
                  match expr with
                  | None => raise OCaml.Not_found
                  | Some expr =>
                    let ctxt := Gas.set_unlimited ctxt in
                    let legacy := true in
                    op_gtgteqquestion (Script.force_decode ctxt expr)
                      (fun function_parameter =>
                        let '(expr, _) := function_parameter in
                        op_gtgteqquestion
                          (Lwt.__return
                            (op_gtgtquestion (parse_toplevel legacy expr)
                              (fun function_parameter =>
                                let '(arg_type, _, _, root_name) :=
                                  function_parameter in
                                op_gtgtquestion
                                  (parse_ty ctxt legacy true false true arg_type)
                                  (fun function_parameter =>
                                    let
                                      '(Tezos_raw_protocol_alpha.Script_ir_translator.Ex_ty
                                        arg_type, _) := function_parameter in
                                    Script_ir_translator.list_entrypoints
                                      arg_type ctxt root_name))))
                          (fun function_parameter =>
                            let '(unreachable_entrypoint, map) :=
                              function_parameter in
                            __return
                              (unreachable_entrypoint,
                                (Entrypoints_map.fold
                                  (fun entry =>
                                    fun function_parameter =>
                                      let '(_, ty) := function_parameter in
                                      fun acc =>
                                        cons
                                          (entry, (Micheline.strip_locations ty))
                                          acc) map []))))
                  end)) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register1 S.contract_big_map_get_opt
      (fun ctxt =>
        fun contract =>
          fun function_parameter =>
            let 'tt := function_parameter in
            fun function_parameter =>
              let '(key, key_type) := function_parameter in
              op_gtgteqquestion (Contract.get_script ctxt contract)
                (fun function_parameter =>
                  let '(ctxt, script) := function_parameter in
                  op_gtgteqquestion
                    (Lwt.__return
                      (Script_ir_translator.parse_packable_ty ctxt true
                        (Micheline.root key_type)))
                    (fun function_parameter =>
                      let
                        '(Tezos_raw_protocol_alpha.Script_ir_translator.Ex_ty
                          key_type, ctxt) := function_parameter in
                      op_gtgteqquestion
                        (Script_ir_translator.parse_data None ctxt true key_type
                          (Micheline.root key))
                        (fun function_parameter =>
                          let '(key, ctxt) := function_parameter in
                          op_gtgteqquestion
                            (Script_ir_translator.hash_data ctxt key_type key)
                            (fun function_parameter =>
                              let '(key, ctxt) := function_parameter in
                              match script with
                              | None => raise OCaml.Not_found
                              | Some script =>
                                let ctxt := Gas.set_unlimited ctxt in
                                op_gtgteqquestion
                                  (parse_script None ctxt true script)
                                  (fun function_parameter =>
                                    let
                                      '(Tezos_raw_protocol_alpha.Script_ir_translator.Ex_script
                                        script, ctxt) := function_parameter in
                                    op_gtgteqquestion
                                      (Script_ir_translator.collect_big_maps
                                        ctxt
                                        (Tezos_raw_protocol_alpha.Script_typed_ir.script.storage_type
                                          script)
                                        (Tezos_raw_protocol_alpha.Script_typed_ir.script.storage
                                          script))
                                      (fun function_parameter =>
                                        let '(ids, _ctxt) := function_parameter
                                          in
                                        let ids :=
                                          Script_ir_translator.list_of_big_map_ids
                                            ids in
                                        let fix find
                                          (function_parameter :
                                          list
                                            Tezos_protocol_environment_alpha__Environment.Z.t)
                                          : Tezos_protocol_environment_alpha__Environment.Lwt.t
                                            (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
                                              (option
                                                (Tezos_protocol_environment_alpha__Environment.Micheline.canonical
                                                  Tezos_raw_protocol_alpha.Alpha_context.Script.prim))) :=
                                          match function_parameter with
                                          | [] => return_none
                                          | cons (_ as id) ids =>
                                            (* ❌ Try-with are not handled *)
                                            try
                                              (op_gtgteqquestion
                                                (do_big_map_get ctxt id key)
                                                return_some)
                                          end in
                                        find ids))
                              end))))) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register2 S.big_map_get
      (fun ctxt =>
        fun id =>
          fun key =>
            fun function_parameter =>
              let 'tt := function_parameter in
              fun function_parameter =>
                let 'tt := function_parameter in
                do_big_map_get ctxt id key) in
  register_field S.info
    (fun ctxt =>
      fun contract =>
        op_gtgteqquestion (Contract.get_balance ctxt contract)
          (fun balance =>
            op_gtgteqquestion (Delegate.get ctxt contract)
              (fun delegate =>
                op_gtgteqquestion
                  match Contract.is_implicit contract with
                  | Some manager =>
                    op_gtgteqquestion (Contract.get_counter ctxt manager)
                      (fun counter => return_some counter)
                  | None => __return None
                  end
                  (fun counter =>
                    op_gtgteqquestion (Contract.get_script ctxt contract)
                      (fun function_parameter =>
                        let '(ctxt, script) := function_parameter in
                        op_gtgteqquestion
                          match script with
                          | None => __return (None, ctxt)
                          | Some script =>
                            let ctxt := Gas.set_unlimited ctxt in
                            op_gtgteqquestion
                              (parse_script None ctxt true script)
                              (fun function_parameter =>
                                let
                                  '(Tezos_raw_protocol_alpha.Script_ir_translator.Ex_script
                                    script, ctxt) := function_parameter in
                                op_gtgteqquestion
                                  (unparse_script ctxt
                                    Tezos_raw_protocol_alpha.Script_ir_translator.Readable
                                    script)
                                  (fun function_parameter =>
                                    let '(script, ctxt) := function_parameter in
                                    __return ((Some script), ctxt)))
                          end
                          (fun function_parameter =>
                            let '(script, _ctxt) := function_parameter in
                            __return
                              {| info.balance := balance;
                                info.delegate := delegate;
                                info.counter := counter; info.script := script
                                |})))))).

Definition __list_value {D E G I K L a b c i o q : Set}
  (ctxt :
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
        (* `POST *) unit + (* `PUT *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> D ->
    q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
          (* `POST *) unit + (* `PUT *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
      -> D -> a -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (G * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
            (* `POST *) unit + (* `PUT *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o -> D -> a -> b -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (I * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
              (* `POST *) unit + (* `PUT *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o -> D -> a -> b -> c -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (K * a * b * c * q * i * o)) * L)))) * L * D) (block : D)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      (list Tezos_raw_protocol_alpha.Alpha_context.Contract.t)) :=
  RPC_context.make_call0 S.__list_value ctxt block tt tt.

Definition info {D E G I K L a b c i o q : Set}
  (ctxt :
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
        (* `POST *) unit + (* `PUT *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> D ->
    q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
          (* `POST *) unit + (* `PUT *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
      -> D -> a -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (G * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
            (* `POST *) unit + (* `PUT *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o -> D -> a -> b -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (I * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
              (* `POST *) unit + (* `PUT *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o -> D -> a -> b -> c -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (K * a * b * c * q * i * o)) * L)))) * L * D) (block : D)
  (contract : Tezos_raw_protocol_alpha.Alpha_context.Contract.contract)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      info) := RPC_context.make_call1 S.info ctxt block contract tt tt.

Definition balance {D E G I K L a b c i o q : Set}
  (ctxt :
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
        (* `POST *) unit + (* `PUT *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> D ->
    q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
          (* `POST *) unit + (* `PUT *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
      -> D -> a -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (G * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
            (* `POST *) unit + (* `PUT *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o -> D -> a -> b -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (I * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
              (* `POST *) unit + (* `PUT *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o -> D -> a -> b -> c -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (K * a * b * c * q * i * o)) * L)))) * L * D) (block : D)
  (contract : Tezos_raw_protocol_alpha.Alpha_context.Contract.contract)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      Tezos_raw_protocol_alpha.Alpha_context.Tez.t) :=
  RPC_context.make_call1 S.balance ctxt block contract tt tt.

Definition manager_key {D E G I K L a b c i o q : Set}
  (ctxt :
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
        (* `POST *) unit + (* `PUT *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> D ->
    q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
          (* `POST *) unit + (* `PUT *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
      -> D -> a -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (G * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
            (* `POST *) unit + (* `PUT *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o -> D -> a -> b -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (I * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
              (* `POST *) unit + (* `PUT *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o -> D -> a -> b -> c -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (K * a * b * c * q * i * o)) * L)))) * L * D) (block : D)
  (mgr : Tezos_raw_protocol_alpha__Alpha_context.public_key_hash)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      (option
        Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t)) :=
  RPC_context.make_call1 S.manager_key ctxt block
    (Contract.implicit_contract mgr) tt tt.

Definition delegate {D E G I K L a b c i o q : Set}
  (ctxt :
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
        (* `POST *) unit + (* `PUT *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> D ->
    q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
          (* `POST *) unit + (* `PUT *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
      -> D -> a -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (G * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
            (* `POST *) unit + (* `PUT *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o -> D -> a -> b -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (I * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
              (* `POST *) unit + (* `PUT *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o -> D -> a -> b -> c -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (K * a * b * c * q * i * o)) * L)))) * L * D) (block : D)
  (contract : Tezos_raw_protocol_alpha.Alpha_context.Contract.contract)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t) :=
  RPC_context.make_call1 S.delegate ctxt block contract tt tt.

Definition delegate_opt {D E G I K L a b c i o q : Set}
  (ctxt :
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
        (* `POST *) unit + (* `PUT *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> D ->
    q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
          (* `POST *) unit + (* `PUT *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
      -> D -> a -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (G * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
            (* `POST *) unit + (* `PUT *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o -> D -> a -> b -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (I * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
              (* `POST *) unit + (* `PUT *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o -> D -> a -> b -> c -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (K * a * b * c * q * i * o)) * L)))) * L * D) (block : D)
  (contract : Tezos_raw_protocol_alpha.Alpha_context.Contract.contract)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      (option
        Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)) :=
  RPC_context.make_opt_call1 S.delegate ctxt block contract tt tt.

Definition counter {D E G I K L a b c i o q : Set}
  (ctxt :
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
        (* `POST *) unit + (* `PUT *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> D ->
    q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
          (* `POST *) unit + (* `PUT *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
      -> D -> a -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (G * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
            (* `POST *) unit + (* `PUT *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o -> D -> a -> b -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (I * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
              (* `POST *) unit + (* `PUT *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o -> D -> a -> b -> c -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (K * a * b * c * q * i * o)) * L)))) * L * D) (block : D)
  (mgr : Tezos_raw_protocol_alpha__Alpha_context.public_key_hash)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      Tezos_protocol_environment_alpha__Environment.Z.t) :=
  RPC_context.make_call1 S.counter ctxt block (Contract.implicit_contract mgr)
    tt tt.

Definition script {D E G I K L a b c i o q : Set}
  (ctxt :
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
        (* `POST *) unit + (* `PUT *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> D ->
    q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
          (* `POST *) unit + (* `PUT *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
      -> D -> a -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (G * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
            (* `POST *) unit + (* `PUT *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o -> D -> a -> b -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (I * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
              (* `POST *) unit + (* `PUT *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o -> D -> a -> b -> c -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (K * a * b * c * q * i * o)) * L)))) * L * D) (block : D)
  (contract : Tezos_raw_protocol_alpha.Alpha_context.Contract.contract)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      Tezos_raw_protocol_alpha.Alpha_context.Script.t) :=
  RPC_context.make_call1 S.script ctxt block contract tt tt.

Definition script_opt {D E G I K L a b c i o q : Set}
  (ctxt :
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
        (* `POST *) unit + (* `PUT *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> D ->
    q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
          (* `POST *) unit + (* `PUT *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
      -> D -> a -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (G * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
            (* `POST *) unit + (* `PUT *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o -> D -> a -> b -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (I * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
              (* `POST *) unit + (* `PUT *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o -> D -> a -> b -> c -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (K * a * b * c * q * i * o)) * L)))) * L * D) (block : D)
  (contract : Tezos_raw_protocol_alpha.Alpha_context.Contract.contract)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      (option Tezos_raw_protocol_alpha.Alpha_context.Script.t)) :=
  RPC_context.make_opt_call1 S.script ctxt block contract tt tt.

Definition storage {D E G I K L a b c i o q : Set}
  (ctxt :
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
        (* `POST *) unit + (* `PUT *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> D ->
    q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
          (* `POST *) unit + (* `PUT *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
      -> D -> a -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (G * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
            (* `POST *) unit + (* `PUT *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o -> D -> a -> b -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (I * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
              (* `POST *) unit + (* `PUT *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o -> D -> a -> b -> c -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (K * a * b * c * q * i * o)) * L)))) * L * D) (block : D)
  (contract : Tezos_raw_protocol_alpha.Alpha_context.Contract.contract)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      Tezos_raw_protocol_alpha.Alpha_context.Script.expr) :=
  RPC_context.make_call1 S.storage ctxt block contract tt tt.

Definition entrypoint_type {D E G I K L a b c i o q : Set}
  (ctxt :
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
        (* `POST *) unit + (* `PUT *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> D ->
    q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
          (* `POST *) unit + (* `PUT *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
      -> D -> a -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (G * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
            (* `POST *) unit + (* `PUT *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o -> D -> a -> b -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (I * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
              (* `POST *) unit + (* `PUT *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o -> D -> a -> b -> c -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (K * a * b * c * q * i * o)) * L)))) * L * D) (block : D)
  (contract : Tezos_raw_protocol_alpha.Alpha_context.Contract.contract)
  (entrypoint : string)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      Tezos_raw_protocol_alpha.Alpha_context.Script.expr) :=
  RPC_context.make_call2 S.entrypoint_type ctxt block contract entrypoint tt tt.

Definition list_entrypoints {D E G I K L a b c i o q : Set}
  (ctxt :
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
        (* `POST *) unit + (* `PUT *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> D ->
    q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
          (* `POST *) unit + (* `PUT *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
      -> D -> a -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (G * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
            (* `POST *) unit + (* `PUT *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o -> D -> a -> b -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (I * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
              (* `POST *) unit + (* `PUT *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o -> D -> a -> b -> c -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (K * a * b * c * q * i * o)) * L)))) * L * D) (block : D)
  (contract : Tezos_raw_protocol_alpha.Alpha_context.Contract.contract)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      (list (list Tezos_raw_protocol_alpha.Michelson_v1_primitives.prim) *
        list (string * Tezos_raw_protocol_alpha.Alpha_context.Script.expr))) :=
  RPC_context.make_call1 S.list_entrypoints ctxt block contract tt tt.

Definition storage_opt {D E G I K L a b c i o q : Set}
  (ctxt :
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
        (* `POST *) unit + (* `PUT *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> D ->
    q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
          (* `POST *) unit + (* `PUT *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
      -> D -> a -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (G * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
            (* `POST *) unit + (* `PUT *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o -> D -> a -> b -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (I * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
              (* `POST *) unit + (* `PUT *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o -> D -> a -> b -> c -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (K * a * b * c * q * i * o)) * L)))) * L * D) (block : D)
  (contract : Tezos_raw_protocol_alpha.Alpha_context.Contract.contract)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      (option Tezos_raw_protocol_alpha.Alpha_context.Script.expr)) :=
  RPC_context.make_opt_call1 S.storage ctxt block contract tt tt.

Definition big_map_get {D E G I K L a b c i o q : Set}
  (ctxt :
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
        (* `POST *) unit + (* `PUT *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> D ->
    q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
          (* `POST *) unit + (* `PUT *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
      -> D -> a -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (G * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
            (* `POST *) unit + (* `PUT *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o -> D -> a -> b -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (I * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
              (* `POST *) unit + (* `PUT *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o -> D -> a -> b -> c -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (K * a * b * c * q * i * o)) * L)))) * L * D) (block : D)
  (id : Tezos_raw_protocol_alpha.Alpha_context.Big_map.id)
  (key : Tezos_raw_protocol_alpha.Script_expr_hash.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      Tezos_raw_protocol_alpha.Alpha_context.Script.expr) :=
  RPC_context.make_call2 S.big_map_get ctxt block id key tt tt.

Definition contract_big_map_get_opt {D E G I K L a b c i o q : Set}
  (ctxt :
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
        (* `POST *) unit + (* `PUT *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> D ->
    q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
          (* `POST *) unit + (* `PUT *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
      -> D -> a -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (G * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
            (* `POST *) unit + (* `PUT *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o -> D -> a -> b -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (I * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
              (* `POST *) unit + (* `PUT *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o -> D -> a -> b -> c -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (K * a * b * c * q * i * o)) * L)))) * L * D) (block : D)
  (contract : Tezos_raw_protocol_alpha.Alpha_context.Contract.contract)
  (key :
    Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
      Tezos_raw_protocol_alpha.Alpha_context.Script.expr)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      (option Tezos_raw_protocol_alpha.Alpha_context.Script.expr)) :=
  RPC_context.make_call1 S.contract_big_map_get_opt ctxt block contract tt key.

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Alpha_context

val list : 'a #RPC_context.simple -> 'a -> Contract.t list shell_tzresult Lwt.t

type info = {
  balance : Tez.t;
  delegate : public_key_hash option;
  counter : counter option;
  script : Script.t option;
}

val info_encoding : info Data_encoding.t

val info :
  'a #RPC_context.simple -> 'a -> Contract.t -> info shell_tzresult Lwt.t

val balance :
  'a #RPC_context.simple -> 'a -> Contract.t -> Tez.t shell_tzresult Lwt.t

val manager_key :
  'a #RPC_context.simple ->
  'a ->
  public_key_hash ->
  public_key option shell_tzresult Lwt.t

val delegate :
  'a #RPC_context.simple ->
  'a ->
  Contract.t ->
  public_key_hash shell_tzresult Lwt.t

val delegate_opt :
  'a #RPC_context.simple ->
  'a ->
  Contract.t ->
  public_key_hash option shell_tzresult Lwt.t

val counter :
  'a #RPC_context.simple ->
  'a ->
  public_key_hash ->
  counter shell_tzresult Lwt.t

val script :
  'a #RPC_context.simple -> 'a -> Contract.t -> Script.t shell_tzresult Lwt.t

val script_opt :
  'a #RPC_context.simple ->
  'a ->
  Contract.t ->
  Script.t option shell_tzresult Lwt.t

val storage :
  'a #RPC_context.simple ->
  'a ->
  Contract.t ->
  Script.expr shell_tzresult Lwt.t

val entrypoint_type :
  'a #RPC_context.simple ->
  'a ->
  Contract.t ->
  string ->
  Script.expr shell_tzresult Lwt.t

val list_entrypoints :
  'a #RPC_context.simple ->
  'a ->
  Contract.t ->
  (Michelson_v1_primitives.prim list list * (string * Script.expr) list)
  shell_tzresult
  Lwt.t

val storage_opt :
  'a #RPC_context.simple ->
  'a ->
  Contract.t ->
  Script.expr option shell_tzresult Lwt.t

val big_map_get :
  'a #RPC_context.simple ->
  'a ->
  Z.t ->
  Script_expr_hash.t ->
  Script.expr shell_tzresult Lwt.t

val contract_big_map_get_opt :
  'a #RPC_context.simple ->
  'a ->
  Contract.t ->
  Script.expr * Script.expr ->
  Script.expr option shell_tzresult Lwt.t

val register : unit -> unit

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Parameter __list_value : forall {E F H J K a b c i o q : Set},
  (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
    ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit +
      (* `PATCH *) unit)
    Tezos_protocol_environment_alpha__Environment.RPC_context.t
    Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> a ->
  q -> i ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult o))
    * (E * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit
        + (* `PATCH *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
    a -> a -> q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (F * a * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
          (* `POST *) unit + (* `PATCH *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
        q i o -> a -> a -> b -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (H * a * b * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
            (* `POST *) unit + (* `PATCH *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
            b) * c) q i o -> a -> a -> b -> c -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (J * a * b * c * q * i * o)) * K)))) * K * a -> a ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      (list Tezos_raw_protocol_alpha.Alpha_context.Contract.t)).

Module info.
  Record record := {
    balance : Tezos_raw_protocol_alpha.Alpha_context.Tez.t;
    delegate : option Tezos_raw_protocol_alpha.Alpha_context.public_key_hash;
    counter : option Tezos_raw_protocol_alpha.Alpha_context.counter;
    script : option Tezos_raw_protocol_alpha.Alpha_context.Script.t }.
End info.
Definition info := info.record.

Parameter info_encoding :
  Tezos_protocol_environment_alpha__Environment.Data_encoding.t info.

Parameter info : forall {E F H J K a b c i o q : Set},
  (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
    ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit +
      (* `PATCH *) unit)
    Tezos_protocol_environment_alpha__Environment.RPC_context.t
    Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> a ->
  q -> i ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult o))
    * (E * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit
        + (* `PATCH *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
    a -> a -> q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (F * a * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
          (* `POST *) unit + (* `PATCH *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
        q i o -> a -> a -> b -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (H * a * b * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
            (* `POST *) unit + (* `PATCH *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
            b) * c) q i o -> a -> a -> b -> c -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (J * a * b * c * q * i * o)) * K)))) * K * a -> a ->
  Tezos_raw_protocol_alpha.Alpha_context.Contract.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      info).

Parameter balance : forall {E F H J K a b c i o q : Set},
  (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
    ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit +
      (* `PATCH *) unit)
    Tezos_protocol_environment_alpha__Environment.RPC_context.t
    Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> a ->
  q -> i ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult o))
    * (E * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit
        + (* `PATCH *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
    a -> a -> q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (F * a * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
          (* `POST *) unit + (* `PATCH *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
        q i o -> a -> a -> b -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (H * a * b * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
            (* `POST *) unit + (* `PATCH *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
            b) * c) q i o -> a -> a -> b -> c -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (J * a * b * c * q * i * o)) * K)))) * K * a -> a ->
  Tezos_raw_protocol_alpha.Alpha_context.Contract.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      Tezos_raw_protocol_alpha.Alpha_context.Tez.t).

Parameter manager_key : forall {E F H J K a b c i o q : Set},
  (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
    ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit +
      (* `PATCH *) unit)
    Tezos_protocol_environment_alpha__Environment.RPC_context.t
    Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> a ->
  q -> i ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult o))
    * (E * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit
        + (* `PATCH *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
    a -> a -> q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (F * a * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
          (* `POST *) unit + (* `PATCH *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
        q i o -> a -> a -> b -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (H * a * b * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
            (* `POST *) unit + (* `PATCH *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
            b) * c) q i o -> a -> a -> b -> c -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (J * a * b * c * q * i * o)) * K)))) * K * a -> a ->
  Tezos_raw_protocol_alpha.Alpha_context.public_key_hash ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      (option Tezos_raw_protocol_alpha.Alpha_context.public_key)).

Parameter delegate : forall {E F H J K a b c i o q : Set},
  (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
    ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit +
      (* `PATCH *) unit)
    Tezos_protocol_environment_alpha__Environment.RPC_context.t
    Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> a ->
  q -> i ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult o))
    * (E * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit
        + (* `PATCH *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
    a -> a -> q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (F * a * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
          (* `POST *) unit + (* `PATCH *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
        q i o -> a -> a -> b -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (H * a * b * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
            (* `POST *) unit + (* `PATCH *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
            b) * c) q i o -> a -> a -> b -> c -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (J * a * b * c * q * i * o)) * K)))) * K * a -> a ->
  Tezos_raw_protocol_alpha.Alpha_context.Contract.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      Tezos_raw_protocol_alpha.Alpha_context.public_key_hash).

Parameter delegate_opt : forall {E F H J K a b c i o q : Set},
  (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
    ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit +
      (* `PATCH *) unit)
    Tezos_protocol_environment_alpha__Environment.RPC_context.t
    Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> a ->
  q -> i ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult o))
    * (E * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit
        + (* `PATCH *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
    a -> a -> q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (F * a * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
          (* `POST *) unit + (* `PATCH *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
        q i o -> a -> a -> b -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (H * a * b * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
            (* `POST *) unit + (* `PATCH *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
            b) * c) q i o -> a -> a -> b -> c -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (J * a * b * c * q * i * o)) * K)))) * K * a -> a ->
  Tezos_raw_protocol_alpha.Alpha_context.Contract.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      (option Tezos_raw_protocol_alpha.Alpha_context.public_key_hash)).

Parameter counter : forall {E F H J K a b c i o q : Set},
  (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
    ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit +
      (* `PATCH *) unit)
    Tezos_protocol_environment_alpha__Environment.RPC_context.t
    Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> a ->
  q -> i ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult o))
    * (E * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit
        + (* `PATCH *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
    a -> a -> q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (F * a * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
          (* `POST *) unit + (* `PATCH *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
        q i o -> a -> a -> b -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (H * a * b * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
            (* `POST *) unit + (* `PATCH *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
            b) * c) q i o -> a -> a -> b -> c -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (J * a * b * c * q * i * o)) * K)))) * K * a -> a ->
  Tezos_raw_protocol_alpha.Alpha_context.public_key_hash ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      Tezos_raw_protocol_alpha.Alpha_context.counter).

Parameter script : forall {E F H J K a b c i o q : Set},
  (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
    ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit +
      (* `PATCH *) unit)
    Tezos_protocol_environment_alpha__Environment.RPC_context.t
    Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> a ->
  q -> i ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult o))
    * (E * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit
        + (* `PATCH *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
    a -> a -> q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (F * a * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
          (* `POST *) unit + (* `PATCH *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
        q i o -> a -> a -> b -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (H * a * b * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
            (* `POST *) unit + (* `PATCH *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
            b) * c) q i o -> a -> a -> b -> c -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (J * a * b * c * q * i * o)) * K)))) * K * a -> a ->
  Tezos_raw_protocol_alpha.Alpha_context.Contract.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      Tezos_raw_protocol_alpha.Alpha_context.Script.t).

Parameter script_opt : forall {E F H J K a b c i o q : Set},
  (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
    ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit +
      (* `PATCH *) unit)
    Tezos_protocol_environment_alpha__Environment.RPC_context.t
    Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> a ->
  q -> i ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult o))
    * (E * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit
        + (* `PATCH *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
    a -> a -> q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (F * a * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
          (* `POST *) unit + (* `PATCH *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
        q i o -> a -> a -> b -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (H * a * b * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
            (* `POST *) unit + (* `PATCH *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
            b) * c) q i o -> a -> a -> b -> c -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (J * a * b * c * q * i * o)) * K)))) * K * a -> a ->
  Tezos_raw_protocol_alpha.Alpha_context.Contract.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      (option Tezos_raw_protocol_alpha.Alpha_context.Script.t)).

Parameter storage : forall {E F H J K a b c i o q : Set},
  (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
    ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit +
      (* `PATCH *) unit)
    Tezos_protocol_environment_alpha__Environment.RPC_context.t
    Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> a ->
  q -> i ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult o))
    * (E * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit
        + (* `PATCH *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
    a -> a -> q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (F * a * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
          (* `POST *) unit + (* `PATCH *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
        q i o -> a -> a -> b -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (H * a * b * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
            (* `POST *) unit + (* `PATCH *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
            b) * c) q i o -> a -> a -> b -> c -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (J * a * b * c * q * i * o)) * K)))) * K * a -> a ->
  Tezos_raw_protocol_alpha.Alpha_context.Contract.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      Tezos_raw_protocol_alpha.Alpha_context.Script.expr).

Parameter entrypoint_type : forall {E F H J K a b c i o q : Set},
  (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
    ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit +
      (* `PATCH *) unit)
    Tezos_protocol_environment_alpha__Environment.RPC_context.t
    Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> a ->
  q -> i ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult o))
    * (E * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit
        + (* `PATCH *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
    a -> a -> q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (F * a * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
          (* `POST *) unit + (* `PATCH *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
        q i o -> a -> a -> b -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (H * a * b * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
            (* `POST *) unit + (* `PATCH *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
            b) * c) q i o -> a -> a -> b -> c -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (J * a * b * c * q * i * o)) * K)))) * K * a -> a ->
  Tezos_raw_protocol_alpha.Alpha_context.Contract.t -> string ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      Tezos_raw_protocol_alpha.Alpha_context.Script.expr).

Parameter list_entrypoints : forall {E F H J K a b c i o q : Set},
  (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
    ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit +
      (* `PATCH *) unit)
    Tezos_protocol_environment_alpha__Environment.RPC_context.t
    Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> a ->
  q -> i ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult o))
    * (E * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit
        + (* `PATCH *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
    a -> a -> q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (F * a * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
          (* `POST *) unit + (* `PATCH *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
        q i o -> a -> a -> b -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (H * a * b * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
            (* `POST *) unit + (* `PATCH *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
            b) * c) q i o -> a -> a -> b -> c -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (J * a * b * c * q * i * o)) * K)))) * K * a -> a ->
  Tezos_raw_protocol_alpha.Alpha_context.Contract.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      (list (list Tezos_raw_protocol_alpha.Michelson_v1_primitives.prim) *
        list (string * Tezos_raw_protocol_alpha.Alpha_context.Script.expr))).

Parameter storage_opt : forall {E F H J K a b c i o q : Set},
  (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
    ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit +
      (* `PATCH *) unit)
    Tezos_protocol_environment_alpha__Environment.RPC_context.t
    Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> a ->
  q -> i ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult o))
    * (E * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit
        + (* `PATCH *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
    a -> a -> q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (F * a * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
          (* `POST *) unit + (* `PATCH *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
        q i o -> a -> a -> b -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (H * a * b * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
            (* `POST *) unit + (* `PATCH *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
            b) * c) q i o -> a -> a -> b -> c -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (J * a * b * c * q * i * o)) * K)))) * K * a -> a ->
  Tezos_raw_protocol_alpha.Alpha_context.Contract.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      (option Tezos_raw_protocol_alpha.Alpha_context.Script.expr)).

Parameter big_map_get : forall {E F H J K a b c i o q : Set},
  (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
    ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit +
      (* `PATCH *) unit)
    Tezos_protocol_environment_alpha__Environment.RPC_context.t
    Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> a ->
  q -> i ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult o))
    * (E * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit
        + (* `PATCH *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
    a -> a -> q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (F * a * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
          (* `POST *) unit + (* `PATCH *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
        q i o -> a -> a -> b -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (H * a * b * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
            (* `POST *) unit + (* `PATCH *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
            b) * c) q i o -> a -> a -> b -> c -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (J * a * b * c * q * i * o)) * K)))) * K * a -> a ->
  Tezos_protocol_environment_alpha__Environment.Z.t ->
  Tezos_raw_protocol_alpha.Script_expr_hash.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      Tezos_raw_protocol_alpha.Alpha_context.Script.expr).

Parameter contract_big_map_get_opt : forall {E F H J K a b c i o q : Set},
  (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
    ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit +
      (* `PATCH *) unit)
    Tezos_protocol_environment_alpha__Environment.RPC_context.t
    Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> a ->
  q -> i ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult o))
    * (E * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit
        + (* `PATCH *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
    a -> a -> q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (F * a * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
          (* `POST *) unit + (* `PATCH *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
        q i o -> a -> a -> b -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (H * a * b * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
            (* `POST *) unit + (* `PATCH *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
            b) * c) q i o -> a -> a -> b -> c -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (J * a * b * c * q * i * o)) * K)))) * K * a -> a ->
  Tezos_raw_protocol_alpha.Alpha_context.Contract.t ->
  Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
    Tezos_raw_protocol_alpha.Alpha_context.Script.expr ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      (option Tezos_raw_protocol_alpha.Alpha_context.Script.expr)).

Parameter register : unit -> unit.

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

type error +=
  | Balance_too_low of Contract_repr.contract * Tez_repr.t * Tez_repr.t
  | (* `Temporary *)
      Counter_in_the_past of Contract_repr.contract * Z.t * Z.t
  | (* `Branch *)
      Counter_in_the_future of Contract_repr.contract * Z.t * Z.t
  | (* `Temporary *)
      Unspendable_contract of Contract_repr.contract
  | (* `Permanent *)
      Non_existing_contract of Contract_repr.contract
  | (* `Temporary *)
      Empty_implicit_contract of Signature.Public_key_hash.t
  | (* `Temporary *)
      Empty_transaction of Contract_repr.t (* `Temporary *)
  | Inconsistent_hash of
      Signature.Public_key.t
      * Signature.Public_key_hash.t
      * Signature.Public_key_hash.t
  | (* `Permanent *)
      Inconsistent_public_key of
      Signature.Public_key.t * Signature.Public_key.t
  | (* `Permanent *)
      Failure of string (* `Permanent *)
  | Previously_revealed_key of Contract_repr.t (* `Permanent *)
  | Unrevealed_manager_key of Contract_repr.t

(* `Permanent *)

let () =
  register_error_kind
    `Permanent
    ~id:"contract.unspendable_contract"
    ~title:"Unspendable contract"
    ~description:
      "An operation tried to spend tokens from an unspendable contract"
    ~pp:(fun ppf c ->
      Format.fprintf
        ppf
        "The tokens of contract %a can only be spent by its script"
        Contract_repr.pp
        c)
    Data_encoding.(obj1 (req "contract" Contract_repr.encoding))
    (function Unspendable_contract c -> Some c | _ -> None)
    (fun c -> Unspendable_contract c) ;
  register_error_kind
    `Temporary
    ~id:"contract.balance_too_low"
    ~title:"Balance too low"
    ~description:
      "An operation tried to spend more tokens than the contract has"
    ~pp:(fun ppf (c, b, a) ->
      Format.fprintf
        ppf
        "Balance of contract %a too low (%a) to spend %a"
        Contract_repr.pp
        c
        Tez_repr.pp
        b
        Tez_repr.pp
        a)
    Data_encoding.(
      obj3
        (req "contract" Contract_repr.encoding)
        (req "balance" Tez_repr.encoding)
        (req "amount" Tez_repr.encoding))
    (function Balance_too_low (c, b, a) -> Some (c, b, a) | _ -> None)
    (fun (c, b, a) -> Balance_too_low (c, b, a)) ;
  register_error_kind
    `Temporary
    ~id:"contract.counter_in_the_future"
    ~title:"Invalid counter (not yet reached) in a manager operation"
    ~description:"An operation assumed a contract counter in the future"
    ~pp:(fun ppf (contract, exp, found) ->
      Format.fprintf
        ppf
        "Counter %s not yet reached for contract %a (expected %s)"
        (Z.to_string found)
        Contract_repr.pp
        contract
        (Z.to_string exp))
    Data_encoding.(
      obj3
        (req "contract" Contract_repr.encoding)
        (req "expected" z)
        (req "found" z))
    (function Counter_in_the_future (c, x, y) -> Some (c, x, y) | _ -> None)
    (fun (c, x, y) -> Counter_in_the_future (c, x, y)) ;
  register_error_kind
    `Branch
    ~id:"contract.counter_in_the_past"
    ~title:"Invalid counter (already used) in a manager operation"
    ~description:"An operation assumed a contract counter in the past"
    ~pp:(fun ppf (contract, exp, found) ->
      Format.fprintf
        ppf
        "Counter %s already used for contract %a (expected %s)"
        (Z.to_string found)
        Contract_repr.pp
        contract
        (Z.to_string exp))
    Data_encoding.(
      obj3
        (req "contract" Contract_repr.encoding)
        (req "expected" z)
        (req "found" z))
    (function Counter_in_the_past (c, x, y) -> Some (c, x, y) | _ -> None)
    (fun (c, x, y) -> Counter_in_the_past (c, x, y)) ;
  register_error_kind
    `Temporary
    ~id:"contract.non_existing_contract"
    ~title:"Non existing contract"
    ~description:
      "A contract handle is not present in the context (either it never was \
       or it has been destroyed)"
    ~pp:(fun ppf contract ->
      Format.fprintf ppf "Contract %a does not exist" Contract_repr.pp contract)
    Data_encoding.(obj1 (req "contract" Contract_repr.encoding))
    (function Non_existing_contract c -> Some c | _ -> None)
    (fun c -> Non_existing_contract c) ;
  register_error_kind
    `Permanent
    ~id:"contract.manager.inconsistent_hash"
    ~title:"Inconsistent public key hash"
    ~description:
      "A revealed manager public key is inconsistent with the announced hash"
    ~pp:(fun ppf (k, eh, ph) ->
      Format.fprintf
        ppf
        "The hash of the manager public key %s is not %a as announced but %a"
        (Signature.Public_key.to_b58check k)
        Signature.Public_key_hash.pp
        ph
        Signature.Public_key_hash.pp
        eh)
    Data_encoding.(
      obj3
        (req "public_key" Signature.Public_key.encoding)
        (req "expected_hash" Signature.Public_key_hash.encoding)
        (req "provided_hash" Signature.Public_key_hash.encoding))
    (function Inconsistent_hash (k, eh, ph) -> Some (k, eh, ph) | _ -> None)
    (fun (k, eh, ph) -> Inconsistent_hash (k, eh, ph)) ;
  register_error_kind
    `Permanent
    ~id:"contract.manager.inconsistent_public_key"
    ~title:"Inconsistent public key"
    ~description:
      "A provided manager public key is different with the public key stored \
       in the contract"
    ~pp:(fun ppf (eh, ph) ->
      Format.fprintf
        ppf
        "Expected manager public key %s but %s was provided"
        (Signature.Public_key.to_b58check ph)
        (Signature.Public_key.to_b58check eh))
    Data_encoding.(
      obj2
        (req "public_key" Signature.Public_key.encoding)
        (req "expected_public_key" Signature.Public_key.encoding))
    (function Inconsistent_public_key (eh, ph) -> Some (eh, ph) | _ -> None)
    (fun (eh, ph) -> Inconsistent_public_key (eh, ph)) ;
  register_error_kind
    `Permanent
    ~id:"contract.failure"
    ~title:"Contract storage failure"
    ~description:"Unexpected contract storage error"
    ~pp:(fun ppf s -> Format.fprintf ppf "Contract_storage.Failure %S" s)
    Data_encoding.(obj1 (req "message" string))
    (function Failure s -> Some s | _ -> None)
    (fun s -> Failure s) ;
  register_error_kind
    `Branch
    ~id:"contract.unrevealed_key"
    ~title:"Manager operation precedes key revelation"
    ~description:
      "One tried to apply a manager operation without revealing the manager \
       public key"
    ~pp:(fun ppf s ->
      Format.fprintf
        ppf
        "Unrevealed manager key for contract %a."
        Contract_repr.pp
        s)
    Data_encoding.(obj1 (req "contract" Contract_repr.encoding))
    (function Unrevealed_manager_key s -> Some s | _ -> None)
    (fun s -> Unrevealed_manager_key s) ;
  register_error_kind
    `Branch
    ~id:"contract.previously_revealed_key"
    ~title:"Manager operation already revealed"
    ~description:"One tried to revealed twice a manager public key"
    ~pp:(fun ppf s ->
      Format.fprintf
        ppf
        "Previously revealed manager key for contract %a."
        Contract_repr.pp
        s)
    Data_encoding.(obj1 (req "contract" Contract_repr.encoding))
    (function Previously_revealed_key s -> Some s | _ -> None)
    (fun s -> Previously_revealed_key s) ;
  register_error_kind
    `Branch
    ~id:"implicit.empty_implicit_contract"
    ~title:"Empty implicit contract"
    ~description:
      "No manager operations are allowed on an empty implicit contract."
    ~pp:(fun ppf implicit ->
      Format.fprintf
        ppf
        "Empty implicit contract (%a)"
        Signature.Public_key_hash.pp
        implicit)
    Data_encoding.(obj1 (req "implicit" Signature.Public_key_hash.encoding))
    (function Empty_implicit_contract c -> Some c | _ -> None)
    (fun c -> Empty_implicit_contract c) ;
  register_error_kind
    `Branch
    ~id:"contract.empty_transaction"
    ~title:"Empty transaction"
    ~description:"Forbidden to credit 0ꜩ to a contract without code."
    ~pp:(fun ppf contract ->
      Format.fprintf
        ppf
        "Transaction of 0ꜩ towards a contract without code are forbidden \
         (%a)."
        Contract_repr.pp
        contract)
    Data_encoding.(obj1 (req "contract" Contract_repr.encoding))
    (function Empty_transaction c -> Some c | _ -> None)
    (fun c -> Empty_transaction c)

let failwith msg = fail (Failure msg)

type big_map_diff_item =
  | Update of {
      big_map : Z.t;
      diff_key : Script_repr.expr;
      diff_key_hash : Script_expr_hash.t;
      diff_value : Script_repr.expr option;
    }
  | Clear of Z.t
  | Copy of Z.t * Z.t
  | Alloc of {
      big_map : Z.t;
      key_type : Script_repr.expr;
      value_type : Script_repr.expr;
    }

type big_map_diff = big_map_diff_item list

let big_map_diff_item_encoding =
  let open Data_encoding in
  union
    [ case
        (Tag 0)
        ~title:"update"
        (obj5
           (req "action" (constant "update"))
           (req "big_map" z)
           (req "key_hash" Script_expr_hash.encoding)
           (req "key" Script_repr.expr_encoding)
           (opt "value" Script_repr.expr_encoding))
        (function
          | Update {big_map; diff_key_hash; diff_key; diff_value} ->
              Some ((), big_map, diff_key_hash, diff_key, diff_value)
          | _ ->
              None)
        (fun ((), big_map, diff_key_hash, diff_key, diff_value) ->
          Update {big_map; diff_key_hash; diff_key; diff_value});
      case
        (Tag 1)
        ~title:"remove"
        (obj2 (req "action" (constant "remove")) (req "big_map" z))
        (function Clear big_map -> Some ((), big_map) | _ -> None)
        (fun ((), big_map) -> Clear big_map);
      case
        (Tag 2)
        ~title:"copy"
        (obj3
           (req "action" (constant "copy"))
           (req "source_big_map" z)
           (req "destination_big_map" z))
        (function Copy (src, dst) -> Some ((), src, dst) | _ -> None)
        (fun ((), src, dst) -> Copy (src, dst));
      case
        (Tag 3)
        ~title:"alloc"
        (obj4
           (req "action" (constant "alloc"))
           (req "big_map" z)
           (req "key_type" Script_repr.expr_encoding)
           (req "value_type" Script_repr.expr_encoding))
        (function
          | Alloc {big_map; key_type; value_type} ->
              Some ((), big_map, key_type, value_type)
          | _ ->
              None)
        (fun ((), big_map, key_type, value_type) ->
          Alloc {big_map; key_type; value_type}) ]

let big_map_diff_encoding =
  let open Data_encoding in
  def "contract.big_map_diff" @@ list big_map_diff_item_encoding

let big_map_key_cost = 65

let big_map_cost = 33

let update_script_big_map c = function
  | None ->
      return (c, Z.zero)
  | Some diff ->
      fold_left_s
        (fun (c, total) -> function Clear id ->
              Storage.Big_map.Total_bytes.get c id
              >>=? fun size ->
              Storage.Big_map.remove_rec c id
              >>= fun c ->
              if Compare.Z.(id < Z.zero) then return (c, total)
              else return (c, Z.sub (Z.sub total size) (Z.of_int big_map_cost))
          | Copy (from, to_) ->
              Storage.Big_map.copy c ~from ~to_
              >>=? fun c ->
              if Compare.Z.(to_ < Z.zero) then return (c, total)
              else
                Storage.Big_map.Total_bytes.get c from
                >>=? fun size ->
                return (c, Z.add (Z.add total size) (Z.of_int big_map_cost))
          | Alloc {big_map; key_type; value_type} ->
              Storage.Big_map.Total_bytes.init c big_map Z.zero
              >>=? fun c ->
              (* Annotations are erased to allow sharing on
                 [Copy]. The types from the contract code are used,
                 these ones are only used to make sure they are
                 compatible during transmissions between contracts,
                 and only need to be compatible, annotations
                 nonwhistanding. *)
              let key_type =
                Micheline.strip_locations
                  (Script_repr.strip_annotations (Micheline.root key_type))
              in
              let value_type =
                Micheline.strip_locations
                  (Script_repr.strip_annotations (Micheline.root value_type))
              in
              Storage.Big_map.Key_type.init c big_map key_type
              >>=? fun c ->
              Storage.Big_map.Value_type.init c big_map value_type
              >>=? fun c ->
              if Compare.Z.(big_map < Z.zero) then return (c, total)
              else return (c, Z.add total (Z.of_int big_map_cost))
          | Update {big_map; diff_key_hash; diff_value = None} ->
              Storage.Big_map.Contents.remove (c, big_map) diff_key_hash
              >>=? fun (c, freed, existed) ->
              let freed =
                if existed then freed + big_map_key_cost else freed
              in
              Storage.Big_map.Total_bytes.get c big_map
              >>=? fun size ->
              Storage.Big_map.Total_bytes.set
                c
                big_map
                (Z.sub size (Z.of_int freed))
              >>=? fun c ->
              if Compare.Z.(big_map < Z.zero) then return (c, total)
              else return (c, Z.sub total (Z.of_int freed))
          | Update {big_map; diff_key_hash; diff_value = Some v} ->
              Storage.Big_map.Contents.init_set (c, big_map) diff_key_hash v
              >>=? fun (c, size_diff, existed) ->
              let size_diff =
                if existed then size_diff else size_diff + big_map_key_cost
              in
              Storage.Big_map.Total_bytes.get c big_map
              >>=? fun size ->
              Storage.Big_map.Total_bytes.set
                c
                big_map
                (Z.add size (Z.of_int size_diff))
              >>=? fun c ->
              if Compare.Z.(big_map < Z.zero) then return (c, total)
              else return (c, Z.add total (Z.of_int size_diff)))
        (c, Z.zero)
        diff

let create_base c ?(prepaid_bootstrap_storage = false)
    (* Free space for bootstrap contracts *)
    contract ~balance ~manager ~delegate ?script () =
  ( match Contract_repr.is_implicit contract with
  | None ->
      return c
  | Some _ ->
      Storage.Contract.Global_counter.get c
      >>=? fun counter -> Storage.Contract.Counter.init c contract counter )
  >>=? fun c ->
  Storage.Contract.Balance.init c contract balance
  >>=? fun c ->
  ( match manager with
  | Some manager ->
      Storage.Contract.Manager.init c contract (Manager_repr.Hash manager)
  | None ->
      return c )
  >>=? fun c ->
  ( match delegate with
  | None ->
      return c
  | Some delegate ->
      Delegate_storage.init c contract delegate )
  >>=? fun c ->
  match script with
  | Some ({Script_repr.code; storage}, big_map_diff) ->
      Storage.Contract.Code.init c contract code
      >>=? fun (c, code_size) ->
      Storage.Contract.Storage.init c contract storage
      >>=? fun (c, storage_size) ->
      update_script_big_map c big_map_diff
      >>=? fun (c, big_map_size) ->
      let total_size =
        Z.add (Z.add (Z.of_int code_size) (Z.of_int storage_size)) big_map_size
      in
      assert (Compare.Z.(total_size >= Z.zero)) ;
      let prepaid_bootstrap_storage =
        if prepaid_bootstrap_storage then total_size else Z.zero
      in
      Storage.Contract.Paid_storage_space.init
        c
        contract
        prepaid_bootstrap_storage
      >>=? fun c ->
      Storage.Contract.Used_storage_space.init c contract total_size
  | None ->
      return c

let originate c ?prepaid_bootstrap_storage contract ~balance ~script ~delegate
    =
  create_base
    c
    ?prepaid_bootstrap_storage
    contract
    ~balance
    ~manager:None
    ~delegate
    ~script
    ()

let create_implicit c manager ~balance =
  create_base
    c
    (Contract_repr.implicit_contract manager)
    ~balance
    ~manager:(Some manager)
    ?script:None
    ~delegate:None
    ()

let delete c contract =
  match Contract_repr.is_implicit contract with
  | None ->
      (* For non implicit contract Big_map should be cleared *)
      failwith "Non implicit contracts cannot be removed"
  | Some _ ->
      Delegate_storage.remove c contract
      >>=? fun c ->
      Storage.Contract.Balance.delete c contract
      >>=? fun c ->
      Storage.Contract.Manager.delete c contract
      >>=? fun c ->
      Storage.Contract.Counter.delete c contract
      >>=? fun c ->
      Storage.Contract.Code.remove c contract
      >>=? fun (c, _, _) ->
      Storage.Contract.Storage.remove c contract
      >>=? fun (c, _, _) ->
      Storage.Contract.Paid_storage_space.remove c contract
      >>= fun c ->
      Storage.Contract.Used_storage_space.remove c contract
      >>= fun c -> return c

let allocated c contract =
  Storage.Contract.Balance.get_option c contract
  >>=? function None -> return_false | Some _ -> return_true

let exists c contract =
  match Contract_repr.is_implicit contract with
  | Some _ ->
      return_true
  | None ->
      allocated c contract

let must_exist c contract =
  exists c contract
  >>=? function
  | true -> return_unit | false -> fail (Non_existing_contract contract)

let must_be_allocated c contract =
  allocated c contract
  >>=? function
  | true ->
      return_unit
  | false -> (
    match Contract_repr.is_implicit contract with
    | Some pkh ->
        fail (Empty_implicit_contract pkh)
    | None ->
        fail (Non_existing_contract contract) )

let list c = Storage.Contract.list c

let fresh_contract_from_current_nonce c =
  Lwt.return (Raw_context.increment_origination_nonce c)
  >>=? fun (c, nonce) -> return (c, Contract_repr.originated_contract nonce)

let originated_from_current_nonce ~since:ctxt_since ~until:ctxt_until =
  Lwt.return (Raw_context.origination_nonce ctxt_since)
  >>=? fun since ->
  Lwt.return (Raw_context.origination_nonce ctxt_until)
  >>=? fun until ->
  filter_map_s
    (fun contract ->
      exists ctxt_until contract
      >>=? function true -> return_some contract | false -> return_none)
    (Contract_repr.originated_contracts ~since ~until)

let check_counter_increment c manager counter =
  let contract = Contract_repr.implicit_contract manager in
  Storage.Contract.Counter.get c contract
  >>=? fun contract_counter ->
  let expected = Z.succ contract_counter in
  if Compare.Z.(expected = counter) then return_unit
  else if Compare.Z.(expected > counter) then
    fail (Counter_in_the_past (contract, expected, counter))
  else fail (Counter_in_the_future (contract, expected, counter))

let increment_counter c manager =
  let contract = Contract_repr.implicit_contract manager in
  Storage.Contract.Global_counter.get c
  >>=? fun global_counter ->
  Storage.Contract.Global_counter.set c (Z.succ global_counter)
  >>=? fun c ->
  Storage.Contract.Counter.get c contract
  >>=? fun contract_counter ->
  Storage.Contract.Counter.set c contract (Z.succ contract_counter)

let get_script_code c contract = Storage.Contract.Code.get_option c contract

let get_script c contract =
  Storage.Contract.Code.get_option c contract
  >>=? fun (c, code) ->
  Storage.Contract.Storage.get_option c contract
  >>=? fun (c, storage) ->
  match (code, storage) with
  | (None, None) ->
      return (c, None)
  | (Some code, Some storage) ->
      return (c, Some {Script_repr.code; storage})
  | (None, Some _) | (Some _, None) ->
      failwith "get_script"

let get_storage ctxt contract =
  Storage.Contract.Storage.get_option ctxt contract
  >>=? function
  | (ctxt, None) ->
      return (ctxt, None)
  | (ctxt, Some storage) ->
      Lwt.return (Script_repr.force_decode storage)
      >>=? fun (storage, cost) ->
      Lwt.return (Raw_context.consume_gas ctxt cost)
      >>=? fun ctxt -> return (ctxt, Some storage)

let get_counter c manager =
  let contract = Contract_repr.implicit_contract manager in
  Storage.Contract.Counter.get_option c contract
  >>=? function
  | None -> (
    match Contract_repr.is_implicit contract with
    | Some _ ->
        Storage.Contract.Global_counter.get c
    | None ->
        failwith "get_counter" )
  | Some v ->
      return v

let get_manager_key c manager =
  let contract = Contract_repr.implicit_contract manager in
  Storage.Contract.Manager.get_option c contract
  >>=? function
  | None ->
      failwith "get_manager_key"
  | Some (Manager_repr.Hash _) ->
      fail (Unrevealed_manager_key contract)
  | Some (Manager_repr.Public_key v) ->
      return v

let is_manager_key_revealed c manager =
  let contract = Contract_repr.implicit_contract manager in
  Storage.Contract.Manager.get_option c contract
  >>=? function
  | None ->
      return_false
  | Some (Manager_repr.Hash _) ->
      return_false
  | Some (Manager_repr.Public_key _) ->
      return_true

let reveal_manager_key c manager public_key =
  let contract = Contract_repr.implicit_contract manager in
  Storage.Contract.Manager.get c contract
  >>=? function
  | Public_key _ ->
      fail (Previously_revealed_key contract)
  | Hash v ->
      let actual_hash = Signature.Public_key.hash public_key in
      if Signature.Public_key_hash.equal actual_hash v then
        let v = Manager_repr.Public_key public_key in
        Storage.Contract.Manager.set c contract v >>=? fun c -> return c
      else fail (Inconsistent_hash (public_key, v, actual_hash))

let get_balance c contract =
  Storage.Contract.Balance.get_option c contract
  >>=? function
  | None -> (
    match Contract_repr.is_implicit contract with
    | Some _ ->
        return Tez_repr.zero
    | None ->
        failwith "get_balance" )
  | Some v ->
      return v

let update_script_storage c contract storage big_map_diff =
  let storage = Script_repr.lazy_expr storage in
  update_script_big_map c big_map_diff
  >>=? fun (c, big_map_size_diff) ->
  Storage.Contract.Storage.set c contract storage
  >>=? fun (c, size_diff) ->
  Storage.Contract.Used_storage_space.get c contract
  >>=? fun previous_size ->
  let new_size =
    Z.add previous_size (Z.add big_map_size_diff (Z.of_int size_diff))
  in
  Storage.Contract.Used_storage_space.set c contract new_size

let spend c contract amount =
  Storage.Contract.Balance.get c contract
  >>=? fun balance ->
  match Tez_repr.(balance -? amount) with
  | Error _ ->
      fail (Balance_too_low (contract, balance, amount))
  | Ok new_balance -> (
      Storage.Contract.Balance.set c contract new_balance
      >>=? fun c ->
      Roll_storage.Contract.remove_amount c contract amount
      >>=? fun c ->
      if Tez_repr.(new_balance > Tez_repr.zero) then return c
      else
        match Contract_repr.is_implicit contract with
        | None ->
            return c (* Never delete originated contracts *)
        | Some pkh -> (
            Delegate_storage.get c contract
            >>=? function
            | Some pkh' ->
                (* Don't delete "delegate" contract *)
                assert (Signature.Public_key_hash.equal pkh pkh') ;
                return c
            | None ->
                (* Delete empty implicit contract *)
                delete c contract ) )

let credit c contract amount =
  ( if Tez_repr.(amount <> Tez_repr.zero) then return c
  else
    Storage.Contract.Code.mem c contract
    >>=? fun (c, target_has_code) ->
    fail_unless target_has_code (Empty_transaction contract)
    >>=? fun () -> return c )
  >>=? fun c ->
  Storage.Contract.Balance.get_option c contract
  >>=? function
  | None -> (
    match Contract_repr.is_implicit contract with
    | None ->
        fail (Non_existing_contract contract)
    | Some manager ->
        create_implicit c manager ~balance:amount )
  | Some balance ->
      Lwt.return Tez_repr.(amount +? balance)
      >>=? fun balance ->
      Storage.Contract.Balance.set c contract balance
      >>=? fun c -> Roll_storage.Contract.add_amount c contract amount

let init c = Storage.Contract.Global_counter.init c Z.zero

let used_storage_space c contract =
  Storage.Contract.Used_storage_space.get_option c contract
  >>=? function None -> return Z.zero | Some fees -> return fees

let paid_storage_space c contract =
  Storage.Contract.Paid_storage_space.get_option c contract
  >>=? function None -> return Z.zero | Some paid_space -> return paid_space

let set_paid_storage_space_and_return_fees_to_pay c contract new_storage_space
    =
  Storage.Contract.Paid_storage_space.get c contract
  >>=? fun already_paid_space ->
  if Compare.Z.(already_paid_space >= new_storage_space) then return (Z.zero, c)
  else
    let to_pay = Z.sub new_storage_space already_paid_space in
    Storage.Contract.Paid_storage_space.set c contract new_storage_space
    >>=? fun c -> return (to_pay, c)

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Top-level evaluations are considered as an error as sources of side-effects *)
Compute
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "contract.unspendable_contract" % string
      "Unspendable contract" % string
      "An operation tried to spend tokens from an unspendable contract" % string
      (Some
        (fun ppf =>
          fun c =>
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "The tokens of contract " % string
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                      " can only be spent by its script" % string
                      Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))
                "The tokens of contract %a can only be spent by its script" %
                  string) Contract_repr.pp c))
      (obj1 (req None None "contract" % string Contract_repr.encoding))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Unspendable_contract
            c => Some c
        | _ => None
        end)
      (fun c =>
        Tezos_protocol_environment_alpha__Environment.Error_monad.Unspendable_contract
          c) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "contract.balance_too_low" % string "Balance too low" % string
      "An operation tried to spend more tokens than the contract has" % string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let '(c, b, a) := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Balance of contract " % string
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                      " too low (" % string
                      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                          ") to spend " % string
                          (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                            Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format))))))
                "Balance of contract %a too low (%a) to spend %a" % string)
              Contract_repr.pp c Tez_repr.pp b Tez_repr.pp a))
      (obj3 (req None None "contract" % string Contract_repr.encoding)
        (req None None "balance" % string Tez_repr.encoding)
        (req None None "amount" % string Tez_repr.encoding))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Balance_too_low
            c b a => Some (c, b, a)
        | _ => None
        end)
      (fun function_parameter =>
        let '(c, b, a) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Balance_too_low
          c b a) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "contract.counter_in_the_future" % string
      "Invalid counter (not yet reached) in a manager operation" % string
      "An operation assumed a contract counter in the future" % string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let '(contract, exp, found) := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Counter " % string
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String
                    Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                      " not yet reached for contract " % string
                      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                          " (expected " % string
                          (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String
                            Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
                            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Char_literal
                              ")" % char
                              Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))))))
                "Counter %s not yet reached for contract %a (expected %s)" %
                  string) (Z.to_string found) Contract_repr.pp contract
              (Z.to_string exp)))
      (obj3 (req None None "contract" % string Contract_repr.encoding)
        (req None None "expected" % string z) (req None None "found" % string z))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Counter_in_the_future
            c x y => Some (c, x, y)
        | _ => None
        end)
      (fun function_parameter =>
        let '(c, x, y) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Counter_in_the_future
          c x y) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "contract.counter_in_the_past" % string
      "Invalid counter (already used) in a manager operation" % string
      "An operation assumed a contract counter in the past" % string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let '(contract, exp, found) := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Counter " % string
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String
                    Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                      " already used for contract " % string
                      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                          " (expected " % string
                          (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String
                            Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
                            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Char_literal
                              ")" % char
                              Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))))))
                "Counter %s already used for contract %a (expected %s)" % string)
              (Z.to_string found) Contract_repr.pp contract (Z.to_string exp)))
      (obj3 (req None None "contract" % string Contract_repr.encoding)
        (req None None "expected" % string z) (req None None "found" % string z))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Counter_in_the_past
            c x y => Some (c, x, y)
        | _ => None
        end)
      (fun function_parameter =>
        let '(c, x, y) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Counter_in_the_past
          c x y) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "contract.non_existing_contract" % string
      "Non existing contract" % string
      "A contract handle is not present in the context (either it never was or it has been destroyed)"
        % string
      (Some
        (fun ppf =>
          fun contract =>
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Contract " % string
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                      " does not exist" % string
                      Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))
                "Contract %a does not exist" % string) Contract_repr.pp contract))
      (obj1 (req None None "contract" % string Contract_repr.encoding))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Non_existing_contract
            c => Some c
        | _ => None
        end)
      (fun c =>
        Tezos_protocol_environment_alpha__Environment.Error_monad.Non_existing_contract
          c) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "contract.manager.inconsistent_hash" % string
      "Inconsistent public key hash" % string
      "A revealed manager public key is inconsistent with the announced hash" %
        string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let '(k, eh, ph) := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "The hash of the manager public key " % string
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String
                    Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                      " is not " % string
                      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                          " as announced but " % string
                          (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                            Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format))))))
                "The hash of the manager public key %s is not %a as announced but %a"
                  % string) (Signature.Public_key.to_b58check k)
              Signature.Public_key_hash.pp ph Signature.Public_key_hash.pp eh))
      (obj3 (req None None "public_key" % string Signature.Public_key.encoding)
        (req None None "expected_hash" % string
          Signature.Public_key_hash.encoding)
        (req None None "provided_hash" % string
          Signature.Public_key_hash.encoding))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Inconsistent_hash
            k eh ph => Some (k, eh, ph)
        | _ => None
        end)
      (fun function_parameter =>
        let '(k, eh, ph) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Inconsistent_hash
          k eh ph) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "contract.manager.inconsistent_public_key" % string
      "Inconsistent public key" % string
      "A provided manager public key is different with the public key stored in the contract"
        % string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let '(eh, ph) := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Expected manager public key " % string
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String
                    Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                      " but " % string
                      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String
                        Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
                        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                          " was provided" % string
                          Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))))
                "Expected manager public key %s but %s was provided" % string)
              (Signature.Public_key.to_b58check ph)
              (Signature.Public_key.to_b58check eh)))
      (obj2 (req None None "public_key" % string Signature.Public_key.encoding)
        (req None None "expected_public_key" % string
          Signature.Public_key.encoding))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Inconsistent_public_key
            eh ph => Some (eh, ph)
        | _ => None
        end)
      (fun function_parameter =>
        let '(eh, ph) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Inconsistent_public_key
          eh ph) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "contract.failure" % string "Contract storage failure" % string
      "Unexpected contract storage error" % string
      (Some
        (fun ppf =>
          fun s =>
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Contract_storage.Failure " % string
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Caml_string
                    Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
                    Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format))
                "Contract_storage.Failure %S" % string) s))
      (obj1 (req None None "message" % string __string_value))
      (fun function_parameter =>
        match function_parameter with
        | Tezos_protocol_environment_alpha__Environment.Error_monad.Failure s =>
          Some s
        | _ => None
        end)
      (fun s =>
        Tezos_protocol_environment_alpha__Environment.Error_monad.Failure s) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "contract.unrevealed_key" % string
      "Manager operation precedes key revelation" % string
      "One tried to apply a manager operation without revealing the manager public key"
        % string
      (Some
        (fun ppf =>
          fun s =>
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Unrevealed manager key for contract " % string
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Char_literal
                      "." % char
                      Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))
                "Unrevealed manager key for contract %a." % string)
              Contract_repr.pp s))
      (obj1 (req None None "contract" % string Contract_repr.encoding))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Unrevealed_manager_key
            s => Some s
        | _ => None
        end)
      (fun s =>
        Tezos_protocol_environment_alpha__Environment.Error_monad.Unrevealed_manager_key
          s) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "contract.previously_revealed_key" % string
      "Manager operation already revealed" % string
      "One tried to revealed twice a manager public key" % string
      (Some
        (fun ppf =>
          fun s =>
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Previously revealed manager key for contract " % string
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Char_literal
                      "." % char
                      Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))
                "Previously revealed manager key for contract %a." % string)
              Contract_repr.pp s))
      (obj1 (req None None "contract" % string Contract_repr.encoding))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Previously_revealed_key
            s => Some s
        | _ => None
        end)
      (fun s =>
        Tezos_protocol_environment_alpha__Environment.Error_monad.Previously_revealed_key
          s) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "implicit.empty_implicit_contract" % string
      "Empty implicit contract" % string
      "No manager operations are allowed on an empty implicit contract." %
        string
      (Some
        (fun ppf =>
          fun implicit =>
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Empty implicit contract (" % string
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Char_literal
                      ")" % char
                      Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))
                "Empty implicit contract (%a)" % string)
              Signature.Public_key_hash.pp implicit))
      (obj1
        (req None None "implicit" % string Signature.Public_key_hash.encoding))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Empty_implicit_contract
            c => Some c
        | _ => None
        end)
      (fun c =>
        Tezos_protocol_environment_alpha__Environment.Error_monad.Empty_implicit_contract
          c) in
  register_error_kind
    (* ❌ Variants not supported *)
    variant "contract.empty_transaction" % string "Empty transaction" % string
    "Forbidden to credit 0ꜩ to a contract without code." % string
    (Some
      (fun ppf =>
        fun contract =>
          Format.fprintf ppf
            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                "Transaction of 0ꜩ towards a contract without code are forbidden ("
                  % string
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                    ")." % string
                    Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))
              "Transaction of 0ꜩ towards a contract without code are forbidden (%a)."
                % string) Contract_repr.pp contract))
    (obj1 (req None None "contract" % string Contract_repr.encoding))
    (fun function_parameter =>
      match function_parameter with
      |
        Tezos_protocol_environment_alpha__Environment.Error_monad.Empty_transaction
          c => Some c
      | _ => None
      end)
    (fun c =>
      Tezos_protocol_environment_alpha__Environment.Error_monad.Empty_transaction
        c).

Definition failwith {A : Set} (msg : string)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult A) :=
  fail (Tezos_protocol_environment_alpha__Environment.Error_monad.Failure msg).

Inductive big_map_diff_item : Set :=
| Update :
  Tezos_protocol_environment_alpha__Environment.Z.t ->
  Tezos_raw_protocol_alpha.Script_repr.expr ->
  Tezos_raw_protocol_alpha.Script_expr_hash.t ->
  option Tezos_raw_protocol_alpha.Script_repr.expr -> big_map_diff_item
| Clear : Tezos_protocol_environment_alpha__Environment.Z.t -> big_map_diff_item
| Copy :
  Tezos_protocol_environment_alpha__Environment.Z.t ->
  Tezos_protocol_environment_alpha__Environment.Z.t -> big_map_diff_item
| Alloc :
  Tezos_protocol_environment_alpha__Environment.Z.t ->
  Tezos_raw_protocol_alpha.Script_repr.expr ->
  Tezos_raw_protocol_alpha.Script_repr.expr -> big_map_diff_item.

Definition big_map_diff := list big_map_diff_item.

Definition big_map_diff_item_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    big_map_diff_item :=
  union None
    (cons
      (__case_value "update" % string None
        (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag 0)
        (obj5 (req None None "action" % string (constant "update" % string))
          (req None None "big_map" % string z)
          (req None None "key_hash" % string Script_expr_hash.encoding)
          (req None None "key" % string Script_repr.expr_encoding)
          (opt None None "value" % string Script_repr.expr_encoding))
        (fun function_parameter =>
          match function_parameter with
          |
            Update {|
              big_map_diff_item.Update.big_map := big_map;
                big_map_diff_item.Update.diff_key := diff_key;
                big_map_diff_item.Update.diff_key_hash := diff_key_hash;
                big_map_diff_item.Update.diff_value := diff_value
                |} => Some (tt, big_map, diff_key_hash, diff_key, diff_value)
          | _ => None
          end)
        (fun function_parameter =>
          let '(tt, big_map, diff_key_hash, diff_key, diff_value) :=
            function_parameter in
          Update
            {| big_map_diff_item.Update.big_map := big_map;
              big_map_diff_item.Update.diff_key := diff_key;
              big_map_diff_item.Update.diff_key_hash := diff_key_hash;
              big_map_diff_item.Update.diff_value := diff_value |}))
      (cons
        (__case_value "remove" % string None
          (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag 1)
          (obj2 (req None None "action" % string (constant "remove" % string))
            (req None None "big_map" % string z))
          (fun function_parameter =>
            match function_parameter with
            | Clear big_map => Some (tt, big_map)
            | _ => None
            end)
          (fun function_parameter =>
            let '(tt, big_map) := function_parameter in
            Clear big_map))
        (cons
          (__case_value "copy" % string None
            (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag 2)
            (obj3 (req None None "action" % string (constant "copy" % string))
              (req None None "source_big_map" % string z)
              (req None None "destination_big_map" % string z))
            (fun function_parameter =>
              match function_parameter with
              | Copy src dst => Some (tt, src, dst)
              | _ => None
              end)
            (fun function_parameter =>
              let '(tt, src, dst) := function_parameter in
              Copy src dst))
          (cons
            (__case_value "alloc" % string None
              (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag 3)
              (obj4
                (req None None "action" % string (constant "alloc" % string))
                (req None None "big_map" % string z)
                (req None None "key_type" % string Script_repr.expr_encoding)
                (req None None "value_type" % string Script_repr.expr_encoding))
              (fun function_parameter =>
                match function_parameter with
                |
                  Alloc {|
                    big_map_diff_item.Alloc.big_map := big_map;
                      big_map_diff_item.Alloc.key_type := key_type;
                      big_map_diff_item.Alloc.value_type := value_type
                      |} => Some (tt, big_map, key_type, value_type)
                | _ => None
                end)
              (fun function_parameter =>
                let '(tt, big_map, key_type, value_type) := function_parameter
                  in
                Alloc
                  {| big_map_diff_item.Alloc.big_map := big_map;
                    big_map_diff_item.Alloc.key_type := key_type;
                    big_map_diff_item.Alloc.value_type := value_type |})) [])))).

Definition big_map_diff_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    (list big_map_diff_item) :=
  op_atat
    (let arg := def "contract.big_map_diff" % string in
    fun eta => arg None None eta) (__list_value None big_map_diff_item_encoding).

Definition big_map_key_cost : Z := 65.

Definition big_map_cost : Z := 33.

Definition update_script_big_map
  (c : Tezos_raw_protocol_alpha.Storage.Big_map.Total_bytes.context)
  (function_parameter : option (list big_map_diff_item))
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Storage.Big_map.Total_bytes.context *
        Tezos_protocol_environment_alpha__Environment.Z.t)) :=
  match function_parameter with
  | None => __return (c, Z.zero)
  | Some diff =>
    fold_left_s
      (fun function_parameter =>
        let '(c, total) := function_parameter in
        fun function_parameter =>
          match function_parameter with
          | Clear id =>
            op_gtgteqquestion (Storage.Big_map.Total_bytes.get c id)
              (fun size =>
                op_gtgteq (Storage.Big_map.remove_rec c id)
                  (fun c =>
                    if op_lt id Z.zero then
                      __return (c, total)
                    else
                      __return
                        (c, (Z.sub (Z.sub total size) (Z.of_int big_map_cost)))))
          | Copy from to_ =>
            op_gtgteqquestion (Storage.Big_map.copy c from to_)
              (fun c =>
                if op_lt to_ Z.zero then
                  __return (c, total)
                else
                  op_gtgteqquestion (Storage.Big_map.Total_bytes.get c from)
                    (fun size =>
                      __return
                        (c, (Z.add (Z.add total size) (Z.of_int big_map_cost)))))
          |
            Alloc {|
              big_map_diff_item.Alloc.big_map := big_map;
                big_map_diff_item.Alloc.key_type := key_type;
                big_map_diff_item.Alloc.value_type := value_type
                |} =>
            op_gtgteqquestion
              (Storage.Big_map.Total_bytes.init c big_map Z.zero)
              (fun c =>
                let key_type :=
                  Micheline.strip_locations
                    (Script_repr.strip_annotations (Micheline.root key_type)) in
                let value_type :=
                  Micheline.strip_locations
                    (Script_repr.strip_annotations (Micheline.root value_type))
                  in
                op_gtgteqquestion
                  (Storage.Big_map.Key_type.init c big_map key_type)
                  (fun c =>
                    op_gtgteqquestion
                      (Storage.Big_map.Value_type.init c big_map value_type)
                      (fun c =>
                        if op_lt big_map Z.zero then
                          __return (c, total)
                        else
                          __return (c, (Z.add total (Z.of_int big_map_cost))))))
          |
            Update {|
              big_map_diff_item.Update.big_map := big_map;
                big_map_diff_item.Update.diff_key_hash := diff_key_hash;
                big_map_diff_item.Update.diff_value := None
                |} =>
            op_gtgteqquestion
              (Storage.Big_map.Contents.remove (c, big_map) diff_key_hash)
              (fun function_parameter =>
                let '(c, freed, existed) := function_parameter in
                let freed :=
                  if existed then
                    op_plus freed big_map_key_cost
                  else
                    freed in
                op_gtgteqquestion (Storage.Big_map.Total_bytes.get c big_map)
                  (fun size =>
                    op_gtgteqquestion
                      (Storage.Big_map.Total_bytes.set c big_map
                        (Z.sub size (Z.of_int freed)))
                      (fun c =>
                        if op_lt big_map Z.zero then
                          __return (c, total)
                        else
                          __return (c, (Z.sub total (Z.of_int freed))))))
          |
            Update {|
              big_map_diff_item.Update.big_map := big_map;
                big_map_diff_item.Update.diff_key_hash := diff_key_hash;
                big_map_diff_item.Update.diff_value := Some v
                |} =>
            op_gtgteqquestion
              (Storage.Big_map.Contents.init_set (c, big_map) diff_key_hash v)
              (fun function_parameter =>
                let '(c, size_diff, existed) := function_parameter in
                let size_diff :=
                  if existed then
                    size_diff
                  else
                    op_plus size_diff big_map_key_cost in
                op_gtgteqquestion (Storage.Big_map.Total_bytes.get c big_map)
                  (fun size =>
                    op_gtgteqquestion
                      (Storage.Big_map.Total_bytes.set c big_map
                        (Z.add size (Z.of_int size_diff)))
                      (fun c =>
                        if op_lt big_map Z.zero then
                          __return (c, total)
                        else
                          __return (c, (Z.add total (Z.of_int size_diff))))))
          end) (c, Z.zero) diff
  end.

Definition create_base
  (c : Tezos_raw_protocol_alpha.Raw_context.t) (op_staroptstar : option bool)
  : Tezos_raw_protocol_alpha.Contract_repr.contract ->
  Tezos_raw_protocol_alpha.Storage.Contract.Balance.value ->
  option
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  option
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  option
    (Tezos_raw_protocol_alpha.Script_repr.t * option (list big_map_diff_item))
  -> unit ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  let prepaid_bootstrap_storage :=
    match op_staroptstar with
    | Some op_starsthstar => op_starsthstar
    | None => false
    end in
  fun contract =>
    fun balance =>
      fun manager =>
        fun delegate =>
          fun script =>
            fun function_parameter =>
              let 'tt := function_parameter in
              op_gtgteqquestion
                match Contract_repr.is_implicit contract with
                | None => __return c
                | Some _ =>
                  op_gtgteqquestion (Storage.Contract.Global_counter.get c)
                    (fun counter =>
                      Storage.Contract.Counter.init c contract counter)
                end
                (fun c =>
                  op_gtgteqquestion
                    (Storage.Contract.Balance.init c contract balance)
                    (fun c =>
                      op_gtgteqquestion
                        match manager with
                        | Some manager =>
                          Storage.Contract.Manager.init c contract
                            (Tezos_raw_protocol_alpha.Manager_repr.Hash manager)
                        | None => __return c
                        end
                        (fun c =>
                          op_gtgteqquestion
                            match delegate with
                            | None => __return c
                            | Some delegate =>
                              Delegate_storage.init c contract delegate
                            end
                            (fun c =>
                              match script with
                              |
                                Some
                                  ({|
                                    Tezos_raw_protocol_alpha.Script_repr.t.code := code;
                                      Tezos_raw_protocol_alpha.Script_repr.t.storage
                                        :=
                                        storage
                                      |}, big_map_diff) =>
                                op_gtgteqquestion
                                  (Storage.Contract.Code.init c contract code)
                                  (fun function_parameter =>
                                    let '(c, code_size) := function_parameter in
                                    op_gtgteqquestion
                                      (Storage.Contract.Storage.init c contract
                                        storage)
                                      (fun function_parameter =>
                                        let '(c, storage_size) :=
                                          function_parameter in
                                        op_gtgteqquestion
                                          (update_script_big_map c big_map_diff)
                                          (fun function_parameter =>
                                            let '(c, big_map_size) :=
                                              function_parameter in
                                            let total_size :=
                                              Z.add
                                                (Z.add (Z.of_int code_size)
                                                  (Z.of_int storage_size))
                                                big_map_size in
                                            (* ❌ Sequences of instructions are not handled (operator ";") *)
                                            let _ :=
                                              (* ❌ Assert instruction is not handled. *)
                                              assert (op_gteq total_size Z.zero)
                                              in
                                            let prepaid_bootstrap_storage :=
                                              if prepaid_bootstrap_storage then
                                                total_size
                                              else
                                                Z.zero in
                                            op_gtgteqquestion
                                              (Storage.Contract.Paid_storage_space.init
                                                c contract
                                                prepaid_bootstrap_storage)
                                              (fun c =>
                                                Storage.Contract.Used_storage_space.init
                                                  c contract total_size))))
                              | None => __return c
                              end)))).

Definition originate
  (c : Tezos_raw_protocol_alpha.Raw_context.t)
  (prepaid_bootstrap_storage : option bool)
  (contract : Tezos_raw_protocol_alpha.Contract_repr.contract)
  (balance : Tezos_raw_protocol_alpha.Storage.Contract.Balance.value)
  (script :
    Tezos_raw_protocol_alpha.Script_repr.t * option (list big_map_diff_item))
  (delegate :
    option
      Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  create_base c prepaid_bootstrap_storage contract balance None delegate
    (Some script) tt.

Definition create_implicit
  (c : Tezos_raw_protocol_alpha.Raw_context.t)
  (manager :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  (balance : Tezos_raw_protocol_alpha.Storage.Contract.Balance.value)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  create_base c None (Contract_repr.implicit_contract manager) balance
    (Some manager) None None tt.

Definition delete
  (c : Tezos_raw_protocol_alpha.Raw_context.t)
  (contract : Tezos_raw_protocol_alpha.Contract_repr.contract)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  match Contract_repr.is_implicit contract with
  | None => failwith "Non implicit contracts cannot be removed" % string
  | Some _ =>
    op_gtgteqquestion (Delegate_storage.remove c contract)
      (fun c =>
        op_gtgteqquestion (Storage.Contract.Balance.delete c contract)
          (fun c =>
            op_gtgteqquestion (Storage.Contract.Manager.delete c contract)
              (fun c =>
                op_gtgteqquestion (Storage.Contract.Counter.delete c contract)
                  (fun c =>
                    op_gtgteqquestion (Storage.Contract.Code.remove c contract)
                      (fun function_parameter =>
                        let '(c, _, _) := function_parameter in
                        op_gtgteqquestion
                          (Storage.Contract.Storage.remove c contract)
                          (fun function_parameter =>
                            let '(c, _, _) := function_parameter in
                            op_gtgteq
                              (Storage.Contract.Paid_storage_space.remove c
                                contract)
                              (fun c =>
                                op_gtgteq
                                  (Storage.Contract.Used_storage_space.remove c
                                    contract) (fun c => __return c))))))))
  end.

Definition allocated
  (c : Tezos_raw_protocol_alpha.Storage.Contract.Balance.context)
  (contract : Tezos_raw_protocol_alpha.Storage.Contract.Balance.key)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult bool) :=
  op_gtgteqquestion (Storage.Contract.Balance.get_option c contract)
    (fun function_parameter =>
      match function_parameter with
      | None => return_false
      | Some _ => return_true
      end).

Definition __exists
  (c : Tezos_raw_protocol_alpha.Storage.Contract.Balance.context)
  (contract : Tezos_raw_protocol_alpha.Contract_repr.contract)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult bool) :=
  match Contract_repr.is_implicit contract with
  | Some _ => return_true
  | None => allocated c contract
  end.

Definition must_exist
  (c : Tezos_raw_protocol_alpha.Storage.Contract.Balance.context)
  (contract : Tezos_raw_protocol_alpha.Contract_repr.contract)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
  op_gtgteqquestion (__exists c contract)
    (fun function_parameter =>
      match function_parameter with
      | true => return_unit
      | false =>
        fail
          (Tezos_protocol_environment_alpha__Environment.Error_monad.Non_existing_contract
            contract)
      end).

Definition must_be_allocated
  (c : Tezos_raw_protocol_alpha.Storage.Contract.Balance.context)
  (contract : Tezos_raw_protocol_alpha.Storage.Contract.Balance.key)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
  op_gtgteqquestion (allocated c contract)
    (fun function_parameter =>
      match function_parameter with
      | true => return_unit
      | false =>
        match Contract_repr.is_implicit contract with
        | Some pkh =>
          fail
            (Tezos_protocol_environment_alpha__Environment.Error_monad.Empty_implicit_contract
              pkh)
        | None =>
          fail
            (Tezos_protocol_environment_alpha__Environment.Error_monad.Non_existing_contract
              contract)
        end
      end).

Definition __list_value (c : Tezos_raw_protocol_alpha.Raw_context.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (list Tezos_raw_protocol_alpha.Contract_repr.t) :=
  Storage.Contract.__list_value c.

Definition fresh_contract_from_current_nonce
  (c : Tezos_raw_protocol_alpha.Raw_context.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Raw_context.t *
        Tezos_raw_protocol_alpha.Contract_repr.contract)) :=
  op_gtgteqquestion (Lwt.__return (Raw_context.increment_origination_nonce c))
    (fun function_parameter =>
      let '(c, nonce) := function_parameter in
      __return (c, (Contract_repr.originated_contract nonce))).

Definition originated_from_current_nonce
  (ctxt_since : Tezos_raw_protocol_alpha.Raw_context.t)
  (ctxt_until : Tezos_raw_protocol_alpha.Raw_context.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (list Tezos_raw_protocol_alpha.Contract_repr.contract)) :=
  op_gtgteqquestion (Lwt.__return (Raw_context.origination_nonce ctxt_since))
    (fun since =>
      op_gtgteqquestion
        (Lwt.__return (Raw_context.origination_nonce ctxt_until))
        (fun until =>
          filter_map_s
            (fun contract =>
              op_gtgteqquestion (__exists ctxt_until contract)
                (fun function_parameter =>
                  match function_parameter with
                  | true => return_some contract
                  | false => return_none
                  end)) (Contract_repr.originated_contracts since until))).

Definition check_counter_increment
  (c : Tezos_raw_protocol_alpha.Storage.Contract.Counter.context)
  (manager :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  (counter : Tezos_protocol_environment_alpha__Environment.Compare.Z.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
  let contract := Contract_repr.implicit_contract manager in
  op_gtgteqquestion (Storage.Contract.Counter.get c contract)
    (fun contract_counter =>
      let expected := Z.succ contract_counter in
      if op_eq expected counter then
        return_unit
      else
        if op_gt expected counter then
          fail
            (Tezos_protocol_environment_alpha__Environment.Error_monad.Counter_in_the_past
              contract expected counter)
        else
          fail
            (Tezos_protocol_environment_alpha__Environment.Error_monad.Counter_in_the_future
              contract expected counter)).

Definition increment_counter
  (c : Tezos_raw_protocol_alpha.Raw_context.t)
  (manager :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  let contract := Contract_repr.implicit_contract manager in
  op_gtgteqquestion (Storage.Contract.Global_counter.get c)
    (fun global_counter =>
      op_gtgteqquestion
        (Storage.Contract.Global_counter.set c (Z.succ global_counter))
        (fun c =>
          op_gtgteqquestion (Storage.Contract.Counter.get c contract)
            (fun contract_counter =>
              Storage.Contract.Counter.set c contract (Z.succ contract_counter)))).

Definition get_script_code
  (c : Tezos_raw_protocol_alpha.Storage.Contract.Code.context)
  (contract : Tezos_raw_protocol_alpha.Storage.Contract.Code.key)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Raw_context.t *
        option Tezos_raw_protocol_alpha.Storage.Contract.Code.value)) :=
  Storage.Contract.Code.get_option c contract.

Definition get_script
  (c : Tezos_raw_protocol_alpha.Storage.Contract.Code.context)
  (contract : Tezos_raw_protocol_alpha.Storage.Contract.Code.key)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Raw_context.t *
        option Tezos_raw_protocol_alpha.Script_repr.t)) :=
  op_gtgteqquestion (Storage.Contract.Code.get_option c contract)
    (fun function_parameter =>
      let '(c, code) := function_parameter in
      op_gtgteqquestion (Storage.Contract.Storage.get_option c contract)
        (fun function_parameter =>
          let '(c, storage) := function_parameter in
          match (code, storage) with
          | (None, None) => __return (c, None)
          | (Some code, Some storage) =>
            __return
              (c,
                (Some
                  {| Tezos_raw_protocol_alpha.Script_repr.t.code := code;
                    Tezos_raw_protocol_alpha.Script_repr.t.storage := storage |}))
          | (None, Some _) | (Some _, None) => failwith "get_script" % string
          end)).

Definition get_storage
  (ctxt : Tezos_raw_protocol_alpha.Storage.Contract.Storage.context)
  (contract : Tezos_raw_protocol_alpha.Storage.Contract.Storage.key)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Raw_context.t *
        option Tezos_raw_protocol_alpha.Script_repr.expr)) :=
  op_gtgteqquestion (Storage.Contract.Storage.get_option ctxt contract)
    (fun function_parameter =>
      match function_parameter with
      | (ctxt, None) => __return (ctxt, None)
      | (ctxt, Some storage) =>
        op_gtgteqquestion (Lwt.__return (Script_repr.force_decode storage))
          (fun function_parameter =>
            let '(storage, cost) := function_parameter in
            op_gtgteqquestion (Lwt.__return (Raw_context.consume_gas ctxt cost))
              (fun ctxt => __return (ctxt, (Some storage))))
      end).

Definition get_counter
  (c : Tezos_raw_protocol_alpha.Storage.Contract.Counter.context)
  (manager :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_protocol_environment_alpha__Environment.Z.t) :=
  let contract := Contract_repr.implicit_contract manager in
  op_gtgteqquestion (Storage.Contract.Counter.get_option c contract)
    (fun function_parameter =>
      match function_parameter with
      | None =>
        match Contract_repr.is_implicit contract with
        | Some _ => Storage.Contract.Global_counter.get c
        | None => failwith "get_counter" % string
        end
      | Some v => __return v
      end).

Definition get_manager_key
  (c : Tezos_raw_protocol_alpha.Storage.Contract.Manager.context)
  (manager :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t) :=
  let contract := Contract_repr.implicit_contract manager in
  op_gtgteqquestion (Storage.Contract.Manager.get_option c contract)
    (fun function_parameter =>
      match function_parameter with
      | None => failwith "get_manager_key" % string
      | Some (Tezos_raw_protocol_alpha.Manager_repr.Hash _) =>
        fail
          (Tezos_protocol_environment_alpha__Environment.Error_monad.Unrevealed_manager_key
            contract)
      | Some (Tezos_raw_protocol_alpha.Manager_repr.Public_key v) => __return v
      end).

Definition is_manager_key_revealed
  (c : Tezos_raw_protocol_alpha.Storage.Contract.Manager.context)
  (manager :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult bool) :=
  let contract := Contract_repr.implicit_contract manager in
  op_gtgteqquestion (Storage.Contract.Manager.get_option c contract)
    (fun function_parameter =>
      match function_parameter with
      | None => return_false
      | Some (Tezos_raw_protocol_alpha.Manager_repr.Hash _) => return_false
      | Some (Tezos_raw_protocol_alpha.Manager_repr.Public_key _) => return_true
      end).

Definition reveal_manager_key
  (c : Tezos_raw_protocol_alpha.Storage.Contract.Manager.context)
  (manager :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  (public_key :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  let contract := Contract_repr.implicit_contract manager in
  op_gtgteqquestion (Storage.Contract.Manager.get c contract)
    (fun function_parameter =>
      match function_parameter with
      | Tezos_raw_protocol_alpha.Manager_repr.Public_key _ =>
        fail
          (Tezos_protocol_environment_alpha__Environment.Error_monad.Previously_revealed_key
            contract)
      | Tezos_raw_protocol_alpha.Manager_repr.Hash v =>
        let actual_hash := Signature.Public_key.__hash_value public_key in
        if Signature.Public_key_hash.equal actual_hash v then
          let v := Tezos_raw_protocol_alpha.Manager_repr.Public_key public_key
            in
          op_gtgteqquestion (Storage.Contract.Manager.set c contract v)
            (fun c => __return c)
        else
          fail
            (Tezos_protocol_environment_alpha__Environment.Error_monad.Inconsistent_hash
              public_key v actual_hash)
      end).

Definition get_balance
  (c : Tezos_raw_protocol_alpha.Storage.Contract.Balance.context)
  (contract : Tezos_raw_protocol_alpha.Storage.Contract.Balance.key)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Tez_repr.t) :=
  op_gtgteqquestion (Storage.Contract.Balance.get_option c contract)
    (fun function_parameter =>
      match function_parameter with
      | None =>
        match Contract_repr.is_implicit contract with
        | Some _ => __return Tez_repr.zero
        | None => failwith "get_balance" % string
        end
      | Some v => __return v
      end).

Definition update_script_storage
  (c : Tezos_raw_protocol_alpha.Storage.Big_map.Total_bytes.context)
  (contract : Tezos_raw_protocol_alpha.Storage.Contract.Storage.key)
  (storage : Tezos_raw_protocol_alpha.Script_repr.expr)
  (big_map_diff : option (list big_map_diff_item))
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  let storage := Script_repr.lazy_expr storage in
  op_gtgteqquestion (update_script_big_map c big_map_diff)
    (fun function_parameter =>
      let '(c, big_map_size_diff) := function_parameter in
      op_gtgteqquestion (Storage.Contract.Storage.set c contract storage)
        (fun function_parameter =>
          let '(c, size_diff) := function_parameter in
          op_gtgteqquestion (Storage.Contract.Used_storage_space.get c contract)
            (fun previous_size =>
              let new_size :=
                Z.add previous_size
                  (Z.add big_map_size_diff (Z.of_int size_diff)) in
              Storage.Contract.Used_storage_space.set c contract new_size))).

Definition spend
  (c : Tezos_raw_protocol_alpha.Storage.Contract.Balance.context)
  (contract : Tezos_raw_protocol_alpha.Storage.Contract.Balance.key)
  (amount : Tezos_raw_protocol_alpha.Tez_repr.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  op_gtgteqquestion (Storage.Contract.Balance.get c contract)
    (fun balance =>
      match op_minusquestion balance amount with
      | Tezos_protocol_environment_alpha__Environment.Pervasives.Error _ =>
        fail
          (Tezos_protocol_environment_alpha__Environment.Error_monad.Balance_too_low
            contract balance amount)
      | Tezos_protocol_environment_alpha__Environment.Pervasives.Ok new_balance
        =>
        op_gtgteqquestion (Storage.Contract.Balance.set c contract new_balance)
          (fun c =>
            op_gtgteqquestion
              (Roll_storage.Contract.remove_amount c contract amount)
              (fun c =>
                if op_gt new_balance Tez_repr.zero then
                  __return c
                else
                  match Contract_repr.is_implicit contract with
                  | None => __return c
                  | Some pkh =>
                    op_gtgteqquestion (Delegate_storage.get c contract)
                      (fun function_parameter =>
                        match function_parameter with
                        | Some pkh' =>
                          (* ❌ Sequences of instructions are not handled (operator ";") *)
                          let _ :=
                            (* ❌ Assert instruction is not handled. *)
                            assert (Signature.Public_key_hash.equal pkh pkh') in
                          __return c
                        | None => delete c contract
                        end)
                  end))
      end).

Definition credit
  (c : Tezos_raw_protocol_alpha.Storage.Contract.Code.context)
  (contract : Tezos_raw_protocol_alpha.Storage.Contract.Code.key)
  (amount : Tezos_raw_protocol_alpha.Tez_repr.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  op_gtgteqquestion
    (if op_ltgt amount Tez_repr.zero then
      __return c
    else
      op_gtgteqquestion (Storage.Contract.Code.mem c contract)
        (fun function_parameter =>
          let '(c, target_has_code) := function_parameter in
          op_gtgteqquestion
            (fail_unless target_has_code
              (Tezos_protocol_environment_alpha__Environment.Error_monad.Empty_transaction
                contract))
            (fun function_parameter =>
              let 'tt := function_parameter in
              __return c)))
    (fun c =>
      op_gtgteqquestion (Storage.Contract.Balance.get_option c contract)
        (fun function_parameter =>
          match function_parameter with
          | None =>
            match Contract_repr.is_implicit contract with
            | None =>
              fail
                (Tezos_protocol_environment_alpha__Environment.Error_monad.Non_existing_contract
                  contract)
            | Some manager => create_implicit c manager amount
            end
          | Some balance =>
            op_gtgteqquestion (Lwt.__return (op_plusquestion amount balance))
              (fun balance =>
                op_gtgteqquestion
                  (Storage.Contract.Balance.set c contract balance)
                  (fun c => Roll_storage.Contract.add_amount c contract amount))
          end)).

Definition init (c : Tezos_raw_protocol_alpha.Raw_context.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  Storage.Contract.Global_counter.init c Z.zero.

Definition used_storage_space
  (c : Tezos_raw_protocol_alpha.Storage.Contract.Used_storage_space.context)
  (contract : Tezos_raw_protocol_alpha.Storage.Contract.Used_storage_space.key)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_protocol_environment_alpha__Environment.Z.t) :=
  op_gtgteqquestion (Storage.Contract.Used_storage_space.get_option c contract)
    (fun function_parameter =>
      match function_parameter with
      | None => __return Z.zero
      | Some fees => __return fees
      end).

Definition paid_storage_space
  (c : Tezos_raw_protocol_alpha.Storage.Contract.Paid_storage_space.context)
  (contract : Tezos_raw_protocol_alpha.Storage.Contract.Paid_storage_space.key)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_protocol_environment_alpha__Environment.Z.t) :=
  op_gtgteqquestion (Storage.Contract.Paid_storage_space.get_option c contract)
    (fun function_parameter =>
      match function_parameter with
      | None => __return Z.zero
      | Some paid_space => __return paid_space
      end).

Definition set_paid_storage_space_and_return_fees_to_pay
  (c : Tezos_raw_protocol_alpha.Storage.Contract.Paid_storage_space.context)
  (contract : Tezos_raw_protocol_alpha.Storage.Contract.Paid_storage_space.key)
  (new_storage_space : Tezos_protocol_environment_alpha__Environment.Compare.Z.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_protocol_environment_alpha__Environment.Z.t *
        Tezos_raw_protocol_alpha.Storage.Contract.Paid_storage_space.context)) :=
  op_gtgteqquestion (Storage.Contract.Paid_storage_space.get c contract)
    (fun already_paid_space =>
      if op_gteq already_paid_space new_storage_space then
        __return (Z.zero, c)
      else
        let to_pay := Z.sub new_storage_space already_paid_space in
        op_gtgteqquestion
          (Storage.Contract.Paid_storage_space.set c contract new_storage_space)
          (fun c => __return (to_pay, c))).

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

type error +=
  | Balance_too_low of Contract_repr.contract * Tez_repr.t * Tez_repr.t
  | (* `Temporary *)
      Counter_in_the_past of Contract_repr.contract * Z.t * Z.t
  | (* `Branch *)
      Counter_in_the_future of Contract_repr.contract * Z.t * Z.t
  | (* `Temporary *)
      Unspendable_contract of Contract_repr.contract
  | (* `Permanent *)
      Non_existing_contract of Contract_repr.contract
  | (* `Temporary *)
      Empty_implicit_contract of Signature.Public_key_hash.t
  | (* `Temporary *)
      Empty_transaction of Contract_repr.t (* `Temporary *)
  | Inconsistent_hash of
      Signature.Public_key.t
      * Signature.Public_key_hash.t
      * Signature.Public_key_hash.t
  | (* `Permanent *)
      Inconsistent_public_key of
      Signature.Public_key.t * Signature.Public_key.t
  | (* `Permanent *)
      Failure of string (* `Permanent *)
  | Previously_revealed_key of Contract_repr.t (* `Permanent *)
  | Unrevealed_manager_key of Contract_repr.t

(* `Permanent *)

val exists : Raw_context.t -> Contract_repr.t -> bool tzresult Lwt.t

val must_exist : Raw_context.t -> Contract_repr.t -> unit tzresult Lwt.t

val allocated : Raw_context.t -> Contract_repr.t -> bool tzresult Lwt.t

val must_be_allocated : Raw_context.t -> Contract_repr.t -> unit tzresult Lwt.t

val list : Raw_context.t -> Contract_repr.t list Lwt.t

val check_counter_increment :
  Raw_context.t -> Signature.Public_key_hash.t -> Z.t -> unit tzresult Lwt.t

val increment_counter :
  Raw_context.t -> Signature.Public_key_hash.t -> Raw_context.t tzresult Lwt.t

val get_manager_key :
  Raw_context.t ->
  Signature.Public_key_hash.t ->
  Signature.Public_key.t tzresult Lwt.t

val is_manager_key_revealed :
  Raw_context.t -> Signature.Public_key_hash.t -> bool tzresult Lwt.t

val reveal_manager_key :
  Raw_context.t ->
  Signature.Public_key_hash.t ->
  Signature.Public_key.t ->
  Raw_context.t tzresult Lwt.t

val get_balance : Raw_context.t -> Contract_repr.t -> Tez_repr.t tzresult Lwt.t

val get_counter :
  Raw_context.t -> Signature.Public_key_hash.t -> Z.t tzresult Lwt.t

val get_script_code :
  Raw_context.t ->
  Contract_repr.t ->
  (Raw_context.t * Script_repr.lazy_expr option) tzresult Lwt.t

val get_script :
  Raw_context.t ->
  Contract_repr.t ->
  (Raw_context.t * Script_repr.t option) tzresult Lwt.t

val get_storage :
  Raw_context.t ->
  Contract_repr.t ->
  (Raw_context.t * Script_repr.expr option) tzresult Lwt.t

type big_map_diff_item =
  | Update of {
      big_map : Z.t;
      diff_key : Script_repr.expr;
      diff_key_hash : Script_expr_hash.t;
      diff_value : Script_repr.expr option;
    }
  | Clear of Z.t
  | Copy of Z.t * Z.t
  | Alloc of {
      big_map : Z.t;
      key_type : Script_repr.expr;
      value_type : Script_repr.expr;
    }

type big_map_diff = big_map_diff_item list

val big_map_diff_encoding : big_map_diff Data_encoding.t

val update_script_storage :
  Raw_context.t ->
  Contract_repr.t ->
  Script_repr.expr ->
  big_map_diff option ->
  Raw_context.t tzresult Lwt.t

val credit :
  Raw_context.t ->
  Contract_repr.t ->
  Tez_repr.t ->
  Raw_context.t tzresult Lwt.t

val spend :
  Raw_context.t ->
  Contract_repr.t ->
  Tez_repr.t ->
  Raw_context.t tzresult Lwt.t

val originate :
  Raw_context.t ->
  ?prepaid_bootstrap_storage:bool ->
  Contract_repr.t ->
  balance:Tez_repr.t ->
  script:Script_repr.t * big_map_diff option ->
  delegate:Signature.Public_key_hash.t option ->
  Raw_context.t tzresult Lwt.t

val fresh_contract_from_current_nonce :
  Raw_context.t -> (Raw_context.t * Contract_repr.t) tzresult Lwt.t

val originated_from_current_nonce :
  since:Raw_context.t ->
  until:Raw_context.t ->
  Contract_repr.t list tzresult Lwt.t

val init : Raw_context.t -> Raw_context.t tzresult Lwt.t

val used_storage_space : Raw_context.t -> Contract_repr.t -> Z.t tzresult Lwt.t

val paid_storage_space : Raw_context.t -> Contract_repr.t -> Z.t tzresult Lwt.t

val set_paid_storage_space_and_return_fees_to_pay :
  Raw_context.t ->
  Contract_repr.t ->
  Z.t ->
  (Z.t * Raw_context.t) tzresult Lwt.t

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

(* extensible_type Tezos_protocol_environment_alpha__Environment.Error_monad.error *)

Parameter __exists :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Contract_repr.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult bool).

Parameter must_exist :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Contract_repr.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit).

Parameter allocated :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Contract_repr.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult bool).

Parameter must_be_allocated :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Contract_repr.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit).

Parameter __list_value :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (list Tezos_raw_protocol_alpha.Contract_repr.t).

Parameter check_counter_increment :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Tezos_protocol_environment_alpha__Environment.Z.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit).

Parameter increment_counter :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t).

Parameter get_manager_key :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t).

Parameter is_manager_key_revealed :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult bool).

Parameter reveal_manager_key :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t).

Parameter get_balance :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Contract_repr.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Tez_repr.t).

Parameter get_counter :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_protocol_environment_alpha__Environment.Z.t).

Parameter get_script_code :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Contract_repr.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Raw_context.t *
        option Tezos_raw_protocol_alpha.Script_repr.lazy_expr)).

Parameter get_script :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Contract_repr.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Raw_context.t *
        option Tezos_raw_protocol_alpha.Script_repr.t)).

Parameter get_storage :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Contract_repr.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Raw_context.t *
        option Tezos_raw_protocol_alpha.Script_repr.expr)).

Inductive big_map_diff_item : Set :=
| Update :
  Tezos_protocol_environment_alpha__Environment.Z.t ->
  Tezos_raw_protocol_alpha.Script_repr.expr ->
  Tezos_raw_protocol_alpha.Script_expr_hash.t ->
  option Tezos_raw_protocol_alpha.Script_repr.expr -> big_map_diff_item
| Clear : Tezos_protocol_environment_alpha__Environment.Z.t -> big_map_diff_item
| Copy :
  Tezos_protocol_environment_alpha__Environment.Z.t ->
  Tezos_protocol_environment_alpha__Environment.Z.t -> big_map_diff_item
| Alloc :
  Tezos_protocol_environment_alpha__Environment.Z.t ->
  Tezos_raw_protocol_alpha.Script_repr.expr ->
  Tezos_raw_protocol_alpha.Script_repr.expr -> big_map_diff_item.

Definition big_map_diff := list big_map_diff_item.

Parameter big_map_diff_encoding :
  Tezos_protocol_environment_alpha__Environment.Data_encoding.t big_map_diff.

Parameter update_script_storage :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Contract_repr.t ->
  Tezos_raw_protocol_alpha.Script_repr.expr -> option big_map_diff ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t).

Parameter credit :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Contract_repr.t ->
  Tezos_raw_protocol_alpha.Tez_repr.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t).

Parameter spend :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Contract_repr.t ->
  Tezos_raw_protocol_alpha.Tez_repr.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t).

Parameter originate :
  Tezos_raw_protocol_alpha.Raw_context.t -> option bool ->
  Tezos_raw_protocol_alpha.Contract_repr.t ->
  Tezos_raw_protocol_alpha.Tez_repr.t ->
  Tezos_raw_protocol_alpha.Script_repr.t * option big_map_diff ->
  option
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t).

Parameter fresh_contract_from_current_nonce :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Raw_context.t *
        Tezos_raw_protocol_alpha.Contract_repr.t)).

Parameter originated_from_current_nonce :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (list Tezos_raw_protocol_alpha.Contract_repr.t)).

Parameter init :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t).

Parameter used_storage_space :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Contract_repr.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_protocol_environment_alpha__Environment.Z.t).

Parameter paid_storage_space :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Contract_repr.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_protocol_environment_alpha__Environment.Z.t).

Parameter set_paid_storage_space_and_return_fees_to_pay :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Contract_repr.t ->
  Tezos_protocol_environment_alpha__Environment.Z.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_protocol_environment_alpha__Environment.Z.t *
        Tezos_raw_protocol_alpha.Raw_context.t)).

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

type t = int32

type cycle = t

let encoding = Data_encoding.int32

let rpc_arg =
  let construct = Int32.to_string in
  let destruct str =
    match Int32.of_string str with
    | exception _ ->
        Error "Cannot parse cycle"
    | cycle ->
        Ok cycle
  in
  RPC_arg.make
    ~descr:"A cycle integer"
    ~name:"block_cycle"
    ~construct
    ~destruct
    ()

let pp ppf cycle = Format.fprintf ppf "%ld" cycle

include (Compare.Int32 : Compare.S with type t := t)

module Map = Map.Make (Compare.Int32)

let root = 0l

let succ = Int32.succ

let pred = function 0l -> None | i -> Some (Int32.pred i)

let add c i =
  assert (Compare.Int.(i > 0)) ;
  Int32.add c (Int32.of_int i)

let sub c i =
  assert (Compare.Int.(i > 0)) ;
  let r = Int32.sub c (Int32.of_int i) in
  if Compare.Int32.(r < 0l) then None else Some r

let to_int32 i = i

let of_int32_exn l =
  if Compare.Int32.(l >= 0l) then l
  else invalid_arg "Level_repr.Cycle.of_int32"

module Index = struct
  type t = cycle

  let path_length = 1

  let to_path c l = Int32.to_string (to_int32 c) :: l

  let of_path = function
    | [s] -> (
      try Some (Int32.of_string s) with _ -> None )
    | _ ->
        None

  let rpc_arg = rpc_arg

  let encoding = encoding

  let compare = compare
end

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Definition t := int32.

Definition cycle := t.

Definition encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding int32 :=
  Data_encoding.__int32_value.

Definition rpc_arg
  : Tezos_protocol_environment_alpha__Environment.RPC_arg.arg int32 :=
  let construct := Int32.to_string in
  let destruct (str : string)
    : Tezos_protocol_environment_alpha__Environment.Pervasives.result int32
      string :=
    let 'cycle := Int32.of_string str in
    Tezos_protocol_environment_alpha__Environment.Pervasives.Ok cycle in
  RPC_arg.make (Some "A cycle integer" % string) "block_cycle" % string destruct
    construct tt.

Definition pp
  (ppf : Tezos_protocol_environment_alpha__Environment.Format.formatter)
  (cycle : int32) : unit :=
  Format.fprintf ppf
    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int32
        Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int_d
        Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
        Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_precision
        Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
      "%ld" % string) cycle.

Export Compare.Int32.

(* ❌ Applications of functors are not handled. *)
functor_application

Definition root : int32 :=
  (* ❌ Constant of type int32 is converted to int *)
  0.

Definition succ : int32 -> int32 := Int32.succ.

Definition pred (function_parameter : int32) : option int32 :=
  match function_parameter with
  |
    (* ❌ Constant of type int32 is converted to int *)
    0 => None
  | i => Some (Int32.pred i)
  end.

Definition add
  (c : int32) (i : Tezos_protocol_environment_alpha__Environment.Compare.Int.t)
  : int32 :=
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    (* ❌ Assert instruction is not handled. *)
    assert (op_gt i 0) in
  Int32.add c (Int32.of_int i).

Definition sub
  (c : int32) (i : Tezos_protocol_environment_alpha__Environment.Compare.Int.t)
  : option int32 :=
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    (* ❌ Assert instruction is not handled. *)
    assert (op_gt i 0) in
  let r := Int32.sub c (Int32.of_int i) in
  if
    op_lt r
      (* ❌ Constant of type int32 is converted to int *)
      0 then
    None
  else
    Some r.

Definition to_int32 {A : Set} (i : A) : A := i.

Definition of_int32_exn
  (l : Tezos_protocol_environment_alpha__Environment.Compare.Int32.t)
  : Tezos_protocol_environment_alpha__Environment.Compare.Int32.t :=
  if
    op_gteq l
      (* ❌ Constant of type int32 is converted to int *)
      0 then
    l
  else
    invalid_arg "Level_repr.Cycle.of_int32" % string.

Module Index.
  Definition t := cycle.
  
  Definition path_length : Z := 1.
  
  Definition to_path (c : int32) (l : list string) : list string :=
    cons (Int32.to_string (to_int32 c)) l.
  
  Definition of_path (function_parameter : list string) : option int32 :=
    match function_parameter with
    | cons s [] =>
      (* ❌ Try-with are not handled *)
      try (Some (Int32.of_string s))
    | _ => None
    end.
  
  Definition rpc_arg
    : Tezos_protocol_environment_alpha__Environment.RPC_arg.arg int32 := rpc_arg.
  
  Definition encoding
    : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding int32 :=
    encoding.
  
  Definition compare : t -> t -> Z := compare.
End Index.

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

type t

type cycle = t

include Compare.S with type t := t

val encoding : cycle Data_encoding.t

val rpc_arg : cycle RPC_arg.arg

val pp : Format.formatter -> cycle -> unit

val root : cycle

val pred : cycle -> cycle option

val add : cycle -> int -> cycle

val sub : cycle -> int -> cycle option

val succ : cycle -> cycle

val to_int32 : cycle -> int32

val of_int32_exn : int32 -> cycle

module Map : S.MAP with type key = cycle

module Index : Storage_description.INDEX with type t = cycle

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Parameter t : Set.

Definition cycle := t.

Parameter op_eq : t -> t -> bool.

Parameter op_ltgt : t -> t -> bool.

Parameter op_lt : t -> t -> bool.

Parameter op_lteq : t -> t -> bool.

Parameter op_gteq : t -> t -> bool.

Parameter op_gt : t -> t -> bool.

Parameter compare : t -> t -> Z.

Parameter equal : t -> t -> bool.

Parameter max : t -> t -> t.

Parameter min : t -> t -> t.

Parameter encoding :
  Tezos_protocol_environment_alpha__Environment.Data_encoding.t cycle.

Parameter rpc_arg :
  Tezos_protocol_environment_alpha__Environment.RPC_arg.arg cycle.

Parameter pp :
  Tezos_protocol_environment_alpha__Environment.Format.formatter -> cycle ->
  unit.

Parameter root : cycle.

Parameter pred : cycle -> option cycle.

Parameter add : cycle -> Z -> cycle.

Parameter sub : cycle -> Z -> option cycle.

Parameter succ : cycle -> cycle.

Parameter to_int32 : cycle -> int32.

Parameter of_int32_exn : int32 -> cycle.

Module Map.
  Definition key := cycle.
  
  Parameter t : forall (a : Set), Set.
  
  Parameter empty : forall {a : Set}, t a.
  
  Parameter is_empty : forall {a : Set}, t a -> bool.
  
  Parameter mem : forall {a : Set}, key -> t a -> bool.
  
  Parameter add : forall {a : Set}, key -> a -> t a -> t a.
  
  Parameter update : forall {a : Set},
    key -> (option a -> option a) -> t a -> t a.
  
  Parameter singleton : forall {a : Set}, key -> a -> t a.
  
  Parameter remove : forall {a : Set}, key -> t a -> t a.
  
  Parameter merge : forall {a b c : Set},
    (key -> option a -> option b -> option c) -> t a -> t b -> t c.
  
  Parameter union : forall {a : Set},
    (key -> a -> a -> option a) -> t a -> t a -> t a.
  
  Parameter compare : forall {a : Set}, (a -> a -> Z) -> t a -> t a -> Z.
  
  Parameter equal : forall {a : Set}, (a -> a -> bool) -> t a -> t a -> bool.
  
  Parameter iter : forall {a : Set}, (key -> a -> unit) -> t a -> unit.
  
  Parameter fold : forall {a b : Set}, (key -> a -> b -> b) -> t a -> b -> b.
  
  Parameter for_all : forall {a : Set}, (key -> a -> bool) -> t a -> bool.
  
  Parameter __exists : forall {a : Set}, (key -> a -> bool) -> t a -> bool.
  
  Parameter filter : forall {a : Set}, (key -> a -> bool) -> t a -> t a.
  
  Parameter partition : forall {a : Set},
    (key -> a -> bool) -> t a -> t a * t a.
  
  Parameter cardinal : forall {a : Set}, t a -> Z.
  
  Parameter bindings : forall {a : Set}, t a -> list (key * a).
  
  Parameter min_binding_opt : forall {a : Set}, t a -> option (key * a).
  
  Parameter max_binding_opt : forall {a : Set}, t a -> option (key * a).
  
  Parameter choose_opt : forall {a : Set}, t a -> option (key * a).
  
  Parameter split : forall {a : Set}, key -> t a -> t a * option a * t a.
  
  Parameter find_opt : forall {a : Set}, key -> t a -> option a.
  
  Parameter find_first_opt : forall {a : Set},
    (key -> bool) -> t a -> option (key * a).
  
  Parameter find_last_opt : forall {a : Set},
    (key -> bool) -> t a -> option (key * a).
  
  Parameter map : forall {a b : Set}, (a -> b) -> t a -> t b.
  
  Parameter mapi : forall {a b : Set}, (key -> a -> b) -> t a -> t b.
End Map.

Module Index.
  Definition t := cycle.
  
  Parameter path_length : Z.
  
  Parameter to_path : t -> list string -> list string.
  
  Parameter of_path : list string -> option t.
  
  Parameter rpc_arg : Tezos_protocol_environment_alpha__Environment.RPC_arg.t t.
  
  Parameter encoding :
    Tezos_protocol_environment_alpha__Environment.Data_encoding.t t.
  
  Parameter compare : t -> t -> Z.
End Index.

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Alpha_context

type info = {
  balance : Tez.t;
  frozen_balance : Tez.t;
  frozen_balance_by_cycle : Delegate.frozen_balance Cycle.Map.t;
  staking_balance : Tez.t;
  delegated_contracts : Contract_repr.t list;
  delegated_balance : Tez.t;
  deactivated : bool;
  grace_period : Cycle.t;
}

let info_encoding =
  let open Data_encoding in
  conv
    (fun { balance;
           frozen_balance;
           frozen_balance_by_cycle;
           staking_balance;
           delegated_contracts;
           delegated_balance;
           deactivated;
           grace_period } ->
      ( balance,
        frozen_balance,
        frozen_balance_by_cycle,
        staking_balance,
        delegated_contracts,
        delegated_balance,
        deactivated,
        grace_period ))
    (fun ( balance,
           frozen_balance,
           frozen_balance_by_cycle,
           staking_balance,
           delegated_contracts,
           delegated_balance,
           deactivated,
           grace_period ) ->
      {
        balance;
        frozen_balance;
        frozen_balance_by_cycle;
        staking_balance;
        delegated_contracts;
        delegated_balance;
        deactivated;
        grace_period;
      })
    (obj8
       (req "balance" Tez.encoding)
       (req "frozen_balance" Tez.encoding)
       (req "frozen_balance_by_cycle" Delegate.frozen_balance_by_cycle_encoding)
       (req "staking_balance" Tez.encoding)
       (req "delegated_contracts" (list Contract_repr.encoding))
       (req "delegated_balance" Tez.encoding)
       (req "deactivated" bool)
       (req "grace_period" Cycle.encoding))

module S = struct
  let path = RPC_path.(open_root / "context" / "delegates")

  open Data_encoding

  type list_query = {active : bool; inactive : bool}

  let list_query : list_query RPC_query.t =
    let open RPC_query in
    query (fun active inactive -> {active; inactive})
    |+ flag "active" (fun t -> t.active)
    |+ flag "inactive" (fun t -> t.inactive)
    |> seal

  let list_delegate =
    RPC_service.get_service
      ~description:"Lists all registered delegates."
      ~query:list_query
      ~output:(list Signature.Public_key_hash.encoding)
      path

  let path = RPC_path.(path /: Signature.Public_key_hash.rpc_arg)

  let info =
    RPC_service.get_service
      ~description:"Everything about a delegate."
      ~query:RPC_query.empty
      ~output:info_encoding
      path

  let balance =
    RPC_service.get_service
      ~description:
        "Returns the full balance of a given delegate, including the frozen \
         balances."
      ~query:RPC_query.empty
      ~output:Tez.encoding
      RPC_path.(path / "balance")

  let frozen_balance =
    RPC_service.get_service
      ~description:
        "Returns the total frozen balances of a given delegate, this includes \
         the frozen deposits, rewards and fees."
      ~query:RPC_query.empty
      ~output:Tez.encoding
      RPC_path.(path / "frozen_balance")

  let frozen_balance_by_cycle =
    RPC_service.get_service
      ~description:
        "Returns the frozen balances of a given delegate, indexed by the \
         cycle by which it will be unfrozen"
      ~query:RPC_query.empty
      ~output:Delegate.frozen_balance_by_cycle_encoding
      RPC_path.(path / "frozen_balance_by_cycle")

  let staking_balance =
    RPC_service.get_service
      ~description:
        "Returns the total amount of tokens delegated to a given delegate. \
         This includes the balances of all the contracts that delegate to it, \
         but also the balance of the delegate itself and its frozen fees and \
         deposits. The rewards do not count in the delegated balance until \
         they are unfrozen."
      ~query:RPC_query.empty
      ~output:Tez.encoding
      RPC_path.(path / "staking_balance")

  let delegated_contracts =
    RPC_service.get_service
      ~description:
        "Returns the list of contracts that delegate to a given delegate."
      ~query:RPC_query.empty
      ~output:(list Contract_repr.encoding)
      RPC_path.(path / "delegated_contracts")

  let delegated_balance =
    RPC_service.get_service
      ~description:
        "Returns the balances of all the contracts that delegate to a given \
         delegate. This excludes the delegate's own balance and its frozen \
         balances."
      ~query:RPC_query.empty
      ~output:Tez.encoding
      RPC_path.(path / "delegated_balance")

  let deactivated =
    RPC_service.get_service
      ~description:
        "Tells whether the delegate is currently tagged as deactivated or not."
      ~query:RPC_query.empty
      ~output:bool
      RPC_path.(path / "deactivated")

  let grace_period =
    RPC_service.get_service
      ~description:
        "Returns the cycle by the end of which the delegate might be \
         deactivated if she fails to execute any delegate action. A \
         deactivated delegate might be reactivated (without loosing any \
         rolls) by simply re-registering as a delegate. For deactivated \
         delegates, this value contains the cycle by which they were \
         deactivated."
      ~query:RPC_query.empty
      ~output:Cycle.encoding
      RPC_path.(path / "grace_period")
end

let register () =
  let open Services_registration in
  register0 S.list_delegate (fun ctxt q () ->
      Delegate.list ctxt
      >>= fun delegates ->
      if q.active && q.inactive then return delegates
      else if q.active then
        filter_map_s
          (fun pkh ->
            Delegate.deactivated ctxt pkh
            >>=? function true -> return_none | false -> return_some pkh)
          delegates
      else if q.inactive then
        filter_map_s
          (fun pkh ->
            Delegate.deactivated ctxt pkh
            >>=? function false -> return_none | true -> return_some pkh)
          delegates
      else return_nil) ;
  register1 S.info (fun ctxt pkh () () ->
      Delegate.full_balance ctxt pkh
      >>=? fun balance ->
      Delegate.frozen_balance ctxt pkh
      >>=? fun frozen_balance ->
      Delegate.frozen_balance_by_cycle ctxt pkh
      >>= fun frozen_balance_by_cycle ->
      Delegate.staking_balance ctxt pkh
      >>=? fun staking_balance ->
      Delegate.delegated_contracts ctxt pkh
      >>= fun delegated_contracts ->
      Delegate.delegated_balance ctxt pkh
      >>=? fun delegated_balance ->
      Delegate.deactivated ctxt pkh
      >>=? fun deactivated ->
      Delegate.grace_period ctxt pkh
      >>=? fun grace_period ->
      return
        {
          balance;
          frozen_balance;
          frozen_balance_by_cycle;
          staking_balance;
          delegated_contracts;
          delegated_balance;
          deactivated;
          grace_period;
        }) ;
  register1 S.balance (fun ctxt pkh () () -> Delegate.full_balance ctxt pkh) ;
  register1 S.frozen_balance (fun ctxt pkh () () ->
      Delegate.frozen_balance ctxt pkh) ;
  register1 S.frozen_balance_by_cycle (fun ctxt pkh () () ->
      Delegate.frozen_balance_by_cycle ctxt pkh >>= return) ;
  register1 S.staking_balance (fun ctxt pkh () () ->
      Delegate.staking_balance ctxt pkh) ;
  register1 S.delegated_contracts (fun ctxt pkh () () ->
      Delegate.delegated_contracts ctxt pkh >>= return) ;
  register1 S.delegated_balance (fun ctxt pkh () () ->
      Delegate.delegated_balance ctxt pkh) ;
  register1 S.deactivated (fun ctxt pkh () () -> Delegate.deactivated ctxt pkh) ;
  register1 S.grace_period (fun ctxt pkh () () ->
      Delegate.grace_period ctxt pkh)

let list ctxt block ?(active = true) ?(inactive = false) () =
  RPC_context.make_call0 S.list_delegate ctxt block {active; inactive} ()

let info ctxt block pkh = RPC_context.make_call1 S.info ctxt block pkh () ()

let balance ctxt block pkh =
  RPC_context.make_call1 S.balance ctxt block pkh () ()

let frozen_balance ctxt block pkh =
  RPC_context.make_call1 S.frozen_balance ctxt block pkh () ()

let frozen_balance_by_cycle ctxt block pkh =
  RPC_context.make_call1 S.frozen_balance_by_cycle ctxt block pkh () ()

let staking_balance ctxt block pkh =
  RPC_context.make_call1 S.staking_balance ctxt block pkh () ()

let delegated_contracts ctxt block pkh =
  RPC_context.make_call1 S.delegated_contracts ctxt block pkh () ()

let delegated_balance ctxt block pkh =
  RPC_context.make_call1 S.delegated_balance ctxt block pkh () ()

let deactivated ctxt block pkh =
  RPC_context.make_call1 S.deactivated ctxt block pkh () ()

let grace_period ctxt block pkh =
  RPC_context.make_call1 S.grace_period ctxt block pkh () ()

let requested_levels ~default ctxt cycles levels =
  match (levels, cycles) with
  | ([], []) ->
      return [default]
  | (levels, cycles) ->
      (* explicitly fail when requested levels or cycle are in the past...
         or too far in the future... *)
      let levels =
        List.sort_uniq
          Level.compare
          (List.concat
             ( List.map (Level.from_raw ctxt) levels
             :: List.map (Level.levels_in_cycle ctxt) cycles ))
      in
      map_s
        (fun level ->
          let current_level = Level.current ctxt in
          if Level.(level <= current_level) then return (level, None)
          else
            Baking.earlier_predecessor_timestamp ctxt level
            >>=? fun timestamp -> return (level, Some timestamp))
        levels

module Baking_rights = struct
  type t = {
    level : Raw_level.t;
    delegate : Signature.Public_key_hash.t;
    priority : int;
    timestamp : Timestamp.t option;
  }

  let encoding =
    let open Data_encoding in
    conv
      (fun {level; delegate; priority; timestamp} ->
        (level, delegate, priority, timestamp))
      (fun (level, delegate, priority, timestamp) ->
        {level; delegate; priority; timestamp})
      (obj4
         (req "level" Raw_level.encoding)
         (req "delegate" Signature.Public_key_hash.encoding)
         (req "priority" uint16)
         (opt "estimated_time" Timestamp.encoding))

  module S = struct
    open Data_encoding

    let custom_root = RPC_path.(open_root / "helpers" / "baking_rights")

    type baking_rights_query = {
      levels : Raw_level.t list;
      cycles : Cycle.t list;
      delegates : Signature.Public_key_hash.t list;
      max_priority : int option;
      all : bool;
    }

    let baking_rights_query =
      let open RPC_query in
      query (fun levels cycles delegates max_priority all ->
          {levels; cycles; delegates; max_priority; all})
      |+ multi_field "level" Raw_level.rpc_arg (fun t -> t.levels)
      |+ multi_field "cycle" Cycle.rpc_arg (fun t -> t.cycles)
      |+ multi_field "delegate" Signature.Public_key_hash.rpc_arg (fun t ->
             t.delegates)
      |+ opt_field "max_priority" RPC_arg.int (fun t -> t.max_priority)
      |+ flag "all" (fun t -> t.all)
      |> seal

    let baking_rights =
      RPC_service.get_service
        ~description:
          "Retrieves the list of delegates allowed to bake a block.\n\
           By default, it gives the best baking priorities for bakers that \
           have at least one opportunity below the 64th priority for the next \
           block.\n\
           Parameters `level` and `cycle` can be used to specify the (valid) \
           level(s) in the past or future at which the baking rights have to \
           be returned. Parameter `delegate` can be used to restrict the \
           results to the given delegates. If parameter `all` is set, all the \
           baking opportunities for each baker at each level are returned, \
           instead of just the first one.\n\
           Returns the list of baking slots. Also returns the minimal \
           timestamps that correspond to these slots. The timestamps are \
           omitted for levels in the past, and are only estimates for levels \
           later that the next block, based on the hypothesis that all \
           predecessor blocks were baked at the first priority."
        ~query:baking_rights_query
        ~output:(list encoding)
        custom_root
  end

  let baking_priorities ctxt max_prio (level, pred_timestamp) =
    Baking.baking_priorities ctxt level
    >>=? fun contract_list ->
    let rec loop l acc priority =
      if Compare.Int.(priority >= max_prio) then return (List.rev acc)
      else
        let (Misc.LCons (pk, next)) = l in
        let delegate = Signature.Public_key.hash pk in
        ( match pred_timestamp with
        | None ->
            return_none
        | Some pred_timestamp ->
            Baking.minimal_time ctxt priority pred_timestamp
            >>=? fun t -> return_some t )
        >>=? fun timestamp ->
        let acc =
          {level = level.level; delegate; priority; timestamp} :: acc
        in
        next () >>=? fun l -> loop l acc (priority + 1)
    in
    loop contract_list [] 0

  let remove_duplicated_delegates rights =
    List.rev @@ fst
    @@ List.fold_left
         (fun (acc, previous) r ->
           if Signature.Public_key_hash.Set.mem r.delegate previous then
             (acc, previous)
           else
             (r :: acc, Signature.Public_key_hash.Set.add r.delegate previous))
         ([], Signature.Public_key_hash.Set.empty)
         rights

  let register () =
    let open Services_registration in
    register0 S.baking_rights (fun ctxt q () ->
        requested_levels
          ~default:
            ( Level.succ ctxt (Level.current ctxt),
              Some (Timestamp.current ctxt) )
          ctxt
          q.cycles
          q.levels
        >>=? fun levels ->
        let max_priority =
          match q.max_priority with None -> 64 | Some max -> max
        in
        map_s (baking_priorities ctxt max_priority) levels
        >>=? fun rights ->
        let rights =
          if q.all then rights else List.map remove_duplicated_delegates rights
        in
        let rights = List.concat rights in
        match q.delegates with
        | [] ->
            return rights
        | _ :: _ as delegates ->
            let is_requested p =
              List.exists
                (Signature.Public_key_hash.equal p.delegate)
                delegates
            in
            return (List.filter is_requested rights))

  let get ctxt ?(levels = []) ?(cycles = []) ?(delegates = []) ?(all = false)
      ?max_priority block =
    RPC_context.make_call0
      S.baking_rights
      ctxt
      block
      {levels; cycles; delegates; max_priority; all}
      ()
end

module Endorsing_rights = struct
  type t = {
    level : Raw_level.t;
    delegate : Signature.Public_key_hash.t;
    slots : int list;
    estimated_time : Time.t option;
  }

  let encoding =
    let open Data_encoding in
    conv
      (fun {level; delegate; slots; estimated_time} ->
        (level, delegate, slots, estimated_time))
      (fun (level, delegate, slots, estimated_time) ->
        {level; delegate; slots; estimated_time})
      (obj4
         (req "level" Raw_level.encoding)
         (req "delegate" Signature.Public_key_hash.encoding)
         (req "slots" (list uint16))
         (opt "estimated_time" Timestamp.encoding))

  module S = struct
    open Data_encoding

    let custom_root = RPC_path.(open_root / "helpers" / "endorsing_rights")

    type endorsing_rights_query = {
      levels : Raw_level.t list;
      cycles : Cycle.t list;
      delegates : Signature.Public_key_hash.t list;
    }

    let endorsing_rights_query =
      let open RPC_query in
      query (fun levels cycles delegates -> {levels; cycles; delegates})
      |+ multi_field "level" Raw_level.rpc_arg (fun t -> t.levels)
      |+ multi_field "cycle" Cycle.rpc_arg (fun t -> t.cycles)
      |+ multi_field "delegate" Signature.Public_key_hash.rpc_arg (fun t ->
             t.delegates)
      |> seal

    let endorsing_rights =
      RPC_service.get_service
        ~description:
          "Retrieves the delegates allowed to endorse a block.\n\
           By default, it gives the endorsement slots for delegates that have \
           at least one in the next block.\n\
           Parameters `level` and `cycle` can be used to specify the (valid) \
           level(s) in the past or future at which the endorsement rights \
           have to be returned. Parameter `delegate` can be used to restrict \
           the results to the given delegates.\n\
           Returns the list of endorsement slots. Also returns the minimal \
           timestamps that correspond to these slots. The timestamps are \
           omitted for levels in the past, and are only estimates for levels \
           later that the next block, based on the hypothesis that all \
           predecessor blocks were baked at the first priority."
        ~query:endorsing_rights_query
        ~output:(list encoding)
        custom_root
  end

  let endorsement_slots ctxt (level, estimated_time) =
    Baking.endorsement_rights ctxt level
    >>=? fun rights ->
    return
      (Signature.Public_key_hash.Map.fold
         (fun delegate (_, slots, _) acc ->
           {level = level.level; delegate; slots; estimated_time} :: acc)
         rights
         [])

  let register () =
    let open Services_registration in
    register0 S.endorsing_rights (fun ctxt q () ->
        requested_levels
          ~default:(Level.current ctxt, Some (Timestamp.current ctxt))
          ctxt
          q.cycles
          q.levels
        >>=? fun levels ->
        map_s (endorsement_slots ctxt) levels
        >>=? fun rights ->
        let rights = List.concat rights in
        match q.delegates with
        | [] ->
            return rights
        | _ :: _ as delegates ->
            let is_requested p =
              List.exists
                (Signature.Public_key_hash.equal p.delegate)
                delegates
            in
            return (List.filter is_requested rights))

  let get ctxt ?(levels = []) ?(cycles = []) ?(delegates = []) block =
    RPC_context.make_call0
      S.endorsing_rights
      ctxt
      block
      {levels; cycles; delegates}
      ()
end

module Endorsing_power = struct
  let endorsing_power ctxt (operation, chain_id) =
    let (Operation_data data) = operation.protocol_data in
    match data.contents with
    | Single (Endorsement _) ->
        Baking.check_endorsement_rights
          ctxt
          chain_id
          {shell = operation.shell; protocol_data = data}
        >>=? fun (_, slots, _) -> return (List.length slots)
    | _ ->
        failwith "Operation is not an endorsement"

  module S = struct
    let endorsing_power =
      let open Data_encoding in
      RPC_service.post_service
        ~description:
          "Get the endorsing power of an endorsement, that is, the number of \
           slots that the endorser has"
        ~query:RPC_query.empty
        ~input:
          (obj2
             (req "endorsement_operation" Operation.encoding)
             (req "chain_id" Chain_id.encoding))
        ~output:int31
        RPC_path.(open_root / "endorsing_power")
  end

  let register () =
    let open Services_registration in
    register0 S.endorsing_power (fun ctxt () (op, chain_id) ->
        endorsing_power ctxt (op, chain_id))

  let get ctxt block op chain_id =
    RPC_context.make_call0 S.endorsing_power ctxt block () (op, chain_id)
end

module Required_endorsements = struct
  let required_endorsements ctxt block_delay =
    return (Baking.minimum_allowed_endorsements ctxt ~block_delay)

  module S = struct
    type t = {block_delay : Period.t}

    let required_endorsements_query =
      let open RPC_query in
      query (fun block_delay -> {block_delay})
      |+ field "block_delay" Period.rpc_arg Period.zero (fun t ->
             t.block_delay)
      |> seal

    let required_endorsements =
      let open Data_encoding in
      RPC_service.get_service
        ~description:
          "Minimum number of endorsements for a block to be valid, given a \
           delay of the block's timestamp with respect to the minimum time to \
           bake at the block's priority"
        ~query:required_endorsements_query
        ~output:int31
        RPC_path.(open_root / "required_endorsements")
  end

  let register () =
    let open Services_registration in
    register0 S.required_endorsements (fun ctxt {block_delay} () ->
        required_endorsements ctxt block_delay)

  let get ctxt block block_delay =
    RPC_context.make_call0 S.required_endorsements ctxt block {block_delay} ()
end

module Minimal_valid_time = struct
  let minimal_valid_time ctxt ~priority ~endorsing_power =
    Baking.minimal_valid_time ctxt ~priority ~endorsing_power

  module S = struct
    type t = {priority : int; endorsing_power : int}

    let minimal_valid_time_query =
      let open RPC_query in
      query (fun priority endorsing_power -> {priority; endorsing_power})
      |+ field "priority" RPC_arg.int 0 (fun t -> t.priority)
      |+ field "endorsing_power" RPC_arg.int 0 (fun t -> t.endorsing_power)
      |> seal

    let minimal_valid_time =
      RPC_service.get_service
        ~description:
          "Minimal valid time for a block given a priority and an endorsing \
           power."
        ~query:minimal_valid_time_query
        ~output:Time.encoding
        RPC_path.(open_root / "minimal_valid_time")
  end

  let register () =
    let open Services_registration in
    register0 S.minimal_valid_time (fun ctxt {priority; endorsing_power} () ->
        minimal_valid_time ctxt ~priority ~endorsing_power)

  let get ctxt block priority endorsing_power =
    RPC_context.make_call0
      S.minimal_valid_time
      ctxt
      block
      {priority; endorsing_power}
      ()
end

let register () =
  register () ;
  Baking_rights.register () ;
  Endorsing_rights.register () ;
  Endorsing_power.register () ;
  Required_endorsements.register () ;
  Minimal_valid_time.register ()

let endorsement_rights ctxt level =
  Endorsing_rights.endorsement_slots ctxt (level, None)
  >>=? fun l ->
  return (List.map (fun {Endorsing_rights.delegate; _} -> delegate) l)

let baking_rights ctxt max_priority =
  let max = match max_priority with None -> 64 | Some m -> m in
  let level = Level.current ctxt in
  Baking_rights.baking_priorities ctxt max (level, None)
  >>=? fun l ->
  return
    ( level.level,
      List.map
        (fun {Baking_rights.delegate; timestamp; _} -> (delegate, timestamp))
        l )

let endorsing_power ctxt operation =
  Endorsing_power.endorsing_power ctxt operation

let required_endorsements ctxt delay =
  Required_endorsements.required_endorsements ctxt delay

let minimal_valid_time ctxt priority endorsing_power =
  Minimal_valid_time.minimal_valid_time ctxt priority endorsing_power

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Import Alpha_context.

Module info.
  Record record := {
    balance : Tezos_raw_protocol_alpha.Alpha_context.Tez.t;
    frozen_balance : Tezos_raw_protocol_alpha.Alpha_context.Tez.t;
    frozen_balance_by_cycle :
      Tezos_raw_protocol_alpha.Alpha_context.Cycle.Map.t
        Tezos_raw_protocol_alpha.Alpha_context.Delegate.frozen_balance;
    staking_balance : Tezos_raw_protocol_alpha.Alpha_context.Tez.t;
    delegated_contracts : list Tezos_raw_protocol_alpha.Contract_repr.t;
    delegated_balance : Tezos_raw_protocol_alpha.Alpha_context.Tez.t;
    deactivated : bool;
    grace_period : Tezos_raw_protocol_alpha.Alpha_context.Cycle.t }.
End info.
Definition info := info.record.

Definition info_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding info :=
  conv
    (fun function_parameter =>
      let '{|
        info.balance := balance;
          info.frozen_balance := frozen_balance;
          info.frozen_balance_by_cycle := frozen_balance_by_cycle;
          info.staking_balance := staking_balance;
          info.delegated_contracts := delegated_contracts;
          info.delegated_balance := delegated_balance;
          info.deactivated := deactivated;
          info.grace_period := grace_period
          |} := function_parameter in
      (balance, frozen_balance, frozen_balance_by_cycle, staking_balance,
        delegated_contracts, delegated_balance, deactivated, grace_period))
    (fun function_parameter =>
      let
        '(balance, frozen_balance, frozen_balance_by_cycle, staking_balance,
          delegated_contracts, delegated_balance, deactivated, grace_period) :=
        function_parameter in
      {| info.balance := balance; info.frozen_balance := frozen_balance;
        info.frozen_balance_by_cycle := frozen_balance_by_cycle;
        info.staking_balance := staking_balance;
        info.delegated_contracts := delegated_contracts;
        info.delegated_balance := delegated_balance;
        info.deactivated := deactivated; info.grace_period := grace_period |})
    None
    (obj8 (req None None "balance" % string Tez.encoding)
      (req None None "frozen_balance" % string Tez.encoding)
      (req None None "frozen_balance_by_cycle" % string
        Delegate.frozen_balance_by_cycle_encoding)
      (req None None "staking_balance" % string Tez.encoding)
      (req None None "delegated_contracts" % string
        (__list_value None Contract_repr.encoding))
      (req None None "delegated_balance" % string Tez.encoding)
      (req None None "deactivated" % string __bool_value)
      (req None None "grace_period" % string Cycle.encoding)).

Module S.
  Definition path
    : Tezos_protocol_environment_alpha__Environment.RPC_path.path
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context :=
    op_div (op_div open_root "context" % string) "delegates" % string.
  
  Import Data_encoding.
  
  Module list_query.
    Record record := {
      active : bool;
      inactive : bool }.
  End list_query.
  Definition list_query := list_query.record.
  
  Definition list_query
    : Tezos_protocol_environment_alpha__Environment.RPC_query.t list_query :=
    op_pipegt
      (op_pipeplus
        (op_pipeplus
          (__query_value
            (fun active =>
              fun inactive =>
                {| list_query.active := active; list_query.inactive := inactive
                  |}))
          (flag None "active" % string (fun t => list_query.active t)))
        (flag None "inactive" % string (fun t => list_query.inactive t))) seal.
  
  Definition list_delegate
    : Tezos_protocol_environment_alpha__Environment.RPC_service.service
      (* `GET *) unit
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
      list_query unit
      (list
        Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t) :=
    RPC_service.get_service (Some "Lists all registered delegates." % string)
      list_query (__list_value None Signature.Public_key_hash.encoding) path.
  
  Definition path
    : Tezos_protocol_environment_alpha__Environment.RPC_path.path
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
      (Tezos_protocol_environment_alpha__Environment.Updater.rpc_context *
        Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t) :=
    op_divcolon path Signature.Public_key_hash.rpc_arg.
  
  Definition info
    : Tezos_protocol_environment_alpha__Environment.RPC_service.service
      (* `GET *) unit
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
      (Tezos_protocol_environment_alpha__Environment.Updater.rpc_context *
        Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
      unit unit info :=
    RPC_service.get_service (Some "Everything about a delegate." % string)
      RPC_query.empty info_encoding path.
  
  Definition balance
    : Tezos_protocol_environment_alpha__Environment.RPC_service.service
      (* `GET *) unit
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
      (Tezos_protocol_environment_alpha__Environment.Updater.rpc_context *
        Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
      unit unit Tezos_raw_protocol_alpha.Alpha_context.Tez.t :=
    RPC_service.get_service
      (Some
        "Returns the full balance of a given delegate, including the frozen balances."
          % string) RPC_query.empty Tez.encoding
      (op_div path "balance" % string).
  
  Definition frozen_balance
    : Tezos_protocol_environment_alpha__Environment.RPC_service.service
      (* `GET *) unit
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
      (Tezos_protocol_environment_alpha__Environment.Updater.rpc_context *
        Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
      unit unit Tezos_raw_protocol_alpha.Alpha_context.Tez.t :=
    RPC_service.get_service
      (Some
        "Returns the total frozen balances of a given delegate, this includes the frozen deposits, rewards and fees."
          % string) RPC_query.empty Tez.encoding
      (op_div path "frozen_balance" % string).
  
  Definition frozen_balance_by_cycle
    : Tezos_protocol_environment_alpha__Environment.RPC_service.service
      (* `GET *) unit
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
      (Tezos_protocol_environment_alpha__Environment.Updater.rpc_context *
        Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
      unit unit
      (Tezos_raw_protocol_alpha__Alpha_context.Cycle.Map.t
        Tezos_raw_protocol_alpha.Alpha_context.Delegate.frozen_balance) :=
    RPC_service.get_service
      (Some
        "Returns the frozen balances of a given delegate, indexed by the cycle by which it will be unfrozen"
          % string) RPC_query.empty Delegate.frozen_balance_by_cycle_encoding
      (op_div path "frozen_balance_by_cycle" % string).
  
  Definition staking_balance
    : Tezos_protocol_environment_alpha__Environment.RPC_service.service
      (* `GET *) unit
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
      (Tezos_protocol_environment_alpha__Environment.Updater.rpc_context *
        Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
      unit unit Tezos_raw_protocol_alpha.Alpha_context.Tez.t :=
    RPC_service.get_service
      (Some
        "Returns the total amount of tokens delegated to a given delegate. This includes the balances of all the contracts that delegate to it, but also the balance of the delegate itself and its frozen fees and deposits. The rewards do not count in the delegated balance until they are unfrozen."
          % string) RPC_query.empty Tez.encoding
      (op_div path "staking_balance" % string).
  
  Definition delegated_contracts
    : Tezos_protocol_environment_alpha__Environment.RPC_service.service
      (* `GET *) unit
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
      (Tezos_protocol_environment_alpha__Environment.Updater.rpc_context *
        Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
      unit unit (list Tezos_raw_protocol_alpha.Contract_repr.contract) :=
    RPC_service.get_service
      (Some
        "Returns the list of contracts that delegate to a given delegate." %
          string) RPC_query.empty (__list_value None Contract_repr.encoding)
      (op_div path "delegated_contracts" % string).
  
  Definition delegated_balance
    : Tezos_protocol_environment_alpha__Environment.RPC_service.service
      (* `GET *) unit
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
      (Tezos_protocol_environment_alpha__Environment.Updater.rpc_context *
        Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
      unit unit Tezos_raw_protocol_alpha.Alpha_context.Tez.t :=
    RPC_service.get_service
      (Some
        "Returns the balances of all the contracts that delegate to a given delegate. This excludes the delegate's own balance and its frozen balances."
          % string) RPC_query.empty Tez.encoding
      (op_div path "delegated_balance" % string).
  
  Definition deactivated
    : Tezos_protocol_environment_alpha__Environment.RPC_service.service
      (* `GET *) unit
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
      (Tezos_protocol_environment_alpha__Environment.Updater.rpc_context *
        Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
      unit unit bool :=
    RPC_service.get_service
      (Some
        "Tells whether the delegate is currently tagged as deactivated or not."
          % string) RPC_query.empty __bool_value
      (op_div path "deactivated" % string).
  
  Definition grace_period
    : Tezos_protocol_environment_alpha__Environment.RPC_service.service
      (* `GET *) unit
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
      (Tezos_protocol_environment_alpha__Environment.Updater.rpc_context *
        Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
      unit unit Tezos_raw_protocol_alpha.Alpha_context.Cycle.t :=
    RPC_service.get_service
      (Some
        "Returns the cycle by the end of which the delegate might be deactivated if she fails to execute any delegate action. A deactivated delegate might be reactivated (without loosing any rolls) by simply re-registering as a delegate. For deactivated delegates, this value contains the cycle by which they were deactivated."
          % string) RPC_query.empty Cycle.encoding
      (op_div path "grace_period" % string).
End S.

Definition register (function_parameter : unit) : unit :=
  let 'tt := function_parameter in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register0 S.list_delegate
      (fun ctxt =>
        fun q =>
          fun function_parameter =>
            let 'tt := function_parameter in
            op_gtgteq (Delegate.__list_value ctxt)
              (fun delegates =>
                if op_andand (S.list_query.active q) (S.list_query.inactive q)
                  then
                  __return delegates
                else
                  if S.list_query.active q then
                    filter_map_s
                      (fun pkh =>
                        op_gtgteqquestion (Delegate.deactivated ctxt pkh)
                          (fun function_parameter =>
                            match function_parameter with
                            | true => return_none
                            | false => return_some pkh
                            end)) delegates
                  else
                    if S.list_query.inactive q then
                      filter_map_s
                        (fun pkh =>
                          op_gtgteqquestion (Delegate.deactivated ctxt pkh)
                            (fun function_parameter =>
                              match function_parameter with
                              | false => return_none
                              | true => return_some pkh
                              end)) delegates
                    else
                      return_nil)) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register1 S.info
      (fun ctxt =>
        fun pkh =>
          fun function_parameter =>
            let 'tt := function_parameter in
            fun function_parameter =>
              let 'tt := function_parameter in
              op_gtgteqquestion (Delegate.full_balance ctxt pkh)
                (fun balance =>
                  op_gtgteqquestion (Delegate.frozen_balance ctxt pkh)
                    (fun frozen_balance =>
                      op_gtgteq (Delegate.frozen_balance_by_cycle ctxt pkh)
                        (fun frozen_balance_by_cycle =>
                          op_gtgteqquestion (Delegate.staking_balance ctxt pkh)
                            (fun staking_balance =>
                              op_gtgteq (Delegate.delegated_contracts ctxt pkh)
                                (fun delegated_contracts =>
                                  op_gtgteqquestion
                                    (Delegate.delegated_balance ctxt pkh)
                                    (fun delegated_balance =>
                                      op_gtgteqquestion
                                        (Delegate.deactivated ctxt pkh)
                                        (fun deactivated =>
                                          op_gtgteqquestion
                                            (Delegate.grace_period ctxt pkh)
                                            (fun grace_period =>
                                              __return
                                                {| info.balance := balance;
                                                  info.frozen_balance :=
                                                    frozen_balance;
                                                  info.frozen_balance_by_cycle :=
                                                    frozen_balance_by_cycle;
                                                  info.staking_balance :=
                                                    staking_balance;
                                                  info.delegated_contracts :=
                                                    delegated_contracts;
                                                  info.delegated_balance :=
                                                    delegated_balance;
                                                  info.deactivated :=
                                                    deactivated;
                                                  info.grace_period :=
                                                    grace_period |}))))))))) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register1 S.balance
      (fun ctxt =>
        fun pkh =>
          fun function_parameter =>
            let 'tt := function_parameter in
            fun function_parameter =>
              let 'tt := function_parameter in
              Delegate.full_balance ctxt pkh) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register1 S.frozen_balance
      (fun ctxt =>
        fun pkh =>
          fun function_parameter =>
            let 'tt := function_parameter in
            fun function_parameter =>
              let 'tt := function_parameter in
              Delegate.frozen_balance ctxt pkh) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register1 S.frozen_balance_by_cycle
      (fun ctxt =>
        fun pkh =>
          fun function_parameter =>
            let 'tt := function_parameter in
            fun function_parameter =>
              let 'tt := function_parameter in
              op_gtgteq (Delegate.frozen_balance_by_cycle ctxt pkh) __return) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register1 S.staking_balance
      (fun ctxt =>
        fun pkh =>
          fun function_parameter =>
            let 'tt := function_parameter in
            fun function_parameter =>
              let 'tt := function_parameter in
              Delegate.staking_balance ctxt pkh) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register1 S.delegated_contracts
      (fun ctxt =>
        fun pkh =>
          fun function_parameter =>
            let 'tt := function_parameter in
            fun function_parameter =>
              let 'tt := function_parameter in
              op_gtgteq (Delegate.delegated_contracts ctxt pkh) __return) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register1 S.delegated_balance
      (fun ctxt =>
        fun pkh =>
          fun function_parameter =>
            let 'tt := function_parameter in
            fun function_parameter =>
              let 'tt := function_parameter in
              Delegate.delegated_balance ctxt pkh) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register1 S.deactivated
      (fun ctxt =>
        fun pkh =>
          fun function_parameter =>
            let 'tt := function_parameter in
            fun function_parameter =>
              let 'tt := function_parameter in
              Delegate.deactivated ctxt pkh) in
  register1 S.grace_period
    (fun ctxt =>
      fun pkh =>
        fun function_parameter =>
          let 'tt := function_parameter in
          fun function_parameter =>
            let 'tt := function_parameter in
            Delegate.grace_period ctxt pkh).

Definition __list_value {D E G I K L a b c i o q : Set}
  (ctxt :
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
        (* `POST *) unit + (* `PUT *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> D ->
    q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
          (* `POST *) unit + (* `PUT *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
      -> D -> a -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (G * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
            (* `POST *) unit + (* `PUT *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o -> D -> a -> b -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (I * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
              (* `POST *) unit + (* `PUT *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o -> D -> a -> b -> c -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (K * a * b * c * q * i * o)) * L)))) * L * D) (block : D)
  (op_staroptstar : option bool)
  : option bool -> unit ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      (list
        Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)) :=
  let active :=
    match op_staroptstar with
    | Some op_starsthstar => op_starsthstar
    | None => true
    end in
  fun op_staroptstar =>
    let inactive :=
      match op_staroptstar with
      | Some op_starsthstar => op_starsthstar
      | None => false
      end in
    fun function_parameter =>
      let 'tt := function_parameter in
      RPC_context.make_call0 S.list_delegate ctxt block
        {| S.list_query.active := active; S.list_query.inactive := inactive |}
        tt.

Definition info {D E G I K L a b c i o q : Set}
  (ctxt :
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
        (* `POST *) unit + (* `PUT *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> D ->
    q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
          (* `POST *) unit + (* `PUT *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
      -> D -> a -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (G * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
            (* `POST *) unit + (* `PUT *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o -> D -> a -> b -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (I * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
              (* `POST *) unit + (* `PUT *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o -> D -> a -> b -> c -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (K * a * b * c * q * i * o)) * L)))) * L * D) (block : D)
  (pkh :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      info) := RPC_context.make_call1 S.info ctxt block pkh tt tt.

Definition balance {D E G I K L a b c i o q : Set}
  (ctxt :
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
        (* `POST *) unit + (* `PUT *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> D ->
    q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
          (* `POST *) unit + (* `PUT *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
      -> D -> a -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (G * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
            (* `POST *) unit + (* `PUT *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o -> D -> a -> b -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (I * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
              (* `POST *) unit + (* `PUT *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o -> D -> a -> b -> c -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (K * a * b * c * q * i * o)) * L)))) * L * D) (block : D)
  (pkh :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      Tezos_raw_protocol_alpha.Alpha_context.Tez.t) :=
  RPC_context.make_call1 S.balance ctxt block pkh tt tt.

Definition frozen_balance {D E G I K L a b c i o q : Set}
  (ctxt :
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
        (* `POST *) unit + (* `PUT *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> D ->
    q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
          (* `POST *) unit + (* `PUT *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
      -> D -> a -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (G * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
            (* `POST *) unit + (* `PUT *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o -> D -> a -> b -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (I * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
              (* `POST *) unit + (* `PUT *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o -> D -> a -> b -> c -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (K * a * b * c * q * i * o)) * L)))) * L * D) (block : D)
  (pkh :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      Tezos_raw_protocol_alpha.Alpha_context.Tez.t) :=
  RPC_context.make_call1 S.frozen_balance ctxt block pkh tt tt.

Definition frozen_balance_by_cycle {D E G I K L a b c i o q : Set}
  (ctxt :
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
        (* `POST *) unit + (* `PUT *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> D ->
    q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
          (* `POST *) unit + (* `PUT *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
      -> D -> a -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (G * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
            (* `POST *) unit + (* `PUT *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o -> D -> a -> b -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (I * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
              (* `POST *) unit + (* `PUT *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o -> D -> a -> b -> c -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (K * a * b * c * q * i * o)) * L)))) * L * D) (block : D)
  (pkh :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      (Tezos_raw_protocol_alpha__Alpha_context.Cycle.Map.t
        Tezos_raw_protocol_alpha.Alpha_context.Delegate.frozen_balance)) :=
  RPC_context.make_call1 S.frozen_balance_by_cycle ctxt block pkh tt tt.

Definition staking_balance {D E G I K L a b c i o q : Set}
  (ctxt :
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
        (* `POST *) unit + (* `PUT *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> D ->
    q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
          (* `POST *) unit + (* `PUT *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
      -> D -> a -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (G * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
            (* `POST *) unit + (* `PUT *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o -> D -> a -> b -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (I * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
              (* `POST *) unit + (* `PUT *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o -> D -> a -> b -> c -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (K * a * b * c * q * i * o)) * L)))) * L * D) (block : D)
  (pkh :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      Tezos_raw_protocol_alpha.Alpha_context.Tez.t) :=
  RPC_context.make_call1 S.staking_balance ctxt block pkh tt tt.

Definition delegated_contracts {D E G I K L a b c i o q : Set}
  (ctxt :
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
        (* `POST *) unit + (* `PUT *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> D ->
    q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
          (* `POST *) unit + (* `PUT *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
      -> D -> a -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (G * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
            (* `POST *) unit + (* `PUT *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o -> D -> a -> b -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (I * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
              (* `POST *) unit + (* `PUT *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o -> D -> a -> b -> c -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (K * a * b * c * q * i * o)) * L)))) * L * D) (block : D)
  (pkh :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      (list Tezos_raw_protocol_alpha.Contract_repr.contract)) :=
  RPC_context.make_call1 S.delegated_contracts ctxt block pkh tt tt.

Definition delegated_balance {D E G I K L a b c i o q : Set}
  (ctxt :
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
        (* `POST *) unit + (* `PUT *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> D ->
    q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
          (* `POST *) unit + (* `PUT *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
      -> D -> a -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (G * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
            (* `POST *) unit + (* `PUT *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o -> D -> a -> b -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (I * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
              (* `POST *) unit + (* `PUT *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o -> D -> a -> b -> c -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (K * a * b * c * q * i * o)) * L)))) * L * D) (block : D)
  (pkh :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      Tezos_raw_protocol_alpha.Alpha_context.Tez.t) :=
  RPC_context.make_call1 S.delegated_balance ctxt block pkh tt tt.

Definition deactivated {D E G I K L a b c i o q : Set}
  (ctxt :
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
        (* `POST *) unit + (* `PUT *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> D ->
    q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
          (* `POST *) unit + (* `PUT *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
      -> D -> a -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (G * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
            (* `POST *) unit + (* `PUT *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o -> D -> a -> b -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (I * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
              (* `POST *) unit + (* `PUT *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o -> D -> a -> b -> c -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (K * a * b * c * q * i * o)) * L)))) * L * D) (block : D)
  (pkh :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      bool) := RPC_context.make_call1 S.deactivated ctxt block pkh tt tt.

Definition grace_period {D E G I K L a b c i o q : Set}
  (ctxt :
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
        (* `POST *) unit + (* `PUT *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> D ->
    q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
          (* `POST *) unit + (* `PUT *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
      -> D -> a -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (G * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
            (* `POST *) unit + (* `PUT *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o -> D -> a -> b -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (I * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
              (* `POST *) unit + (* `PUT *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o -> D -> a -> b -> c -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (K * a * b * c * q * i * o)) * L)))) * L * D) (block : D)
  (pkh :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      Tezos_raw_protocol_alpha.Alpha_context.Cycle.t) :=
  RPC_context.make_call1 S.grace_period ctxt block pkh tt tt.

Definition requested_levels
  (default :
    Tezos_raw_protocol_alpha.Alpha_context.Level.t *
      option Tezos_raw_protocol_alpha.Alpha_context.Timestamp.t)
  (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
  (cycles : list Tezos_raw_protocol_alpha__Alpha_context.Cycle.t)
  (levels : list Tezos_raw_protocol_alpha__Alpha_context.Raw_level.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (list
        (Tezos_raw_protocol_alpha.Alpha_context.Level.t *
          option Tezos_raw_protocol_alpha.Alpha_context.Timestamp.t))) :=
  match (levels, cycles) with
  | ([], []) => __return (cons default [])
  | (levels, cycles) =>
    let levels :=
      List.sort_uniq Level.compare
        (List.concat
          (cons
            (List.map
              (let arg := Level.from_raw ctxt in
              fun eta => arg None eta) levels)
            (List.map (Level.levels_in_cycle ctxt) cycles))) in
    map_s
      (fun level =>
        let current_level := Level.current ctxt in
        if op_lteq level current_level then
          __return (level, None)
        else
          op_gtgteqquestion (Baking.earlier_predecessor_timestamp ctxt level)
            (fun timestamp => __return (level, (Some timestamp)))) levels
  end.

Module Baking_rights.
  Module t.
    Record record := {
      level : Tezos_raw_protocol_alpha.Alpha_context.Raw_level.t;
      delegate :
        Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t;
      priority : Z;
      timestamp : option Tezos_raw_protocol_alpha.Alpha_context.Timestamp.t }.
  End t.
  Definition t := t.record.
  
  Definition encoding
    : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding t :=
    conv
      (fun function_parameter =>
        let '{|
          t.level := level;
            t.delegate := delegate;
            t.priority := priority;
            t.timestamp := timestamp
            |} := function_parameter in
        (level, delegate, priority, timestamp))
      (fun function_parameter =>
        let '(level, delegate, priority, timestamp) := function_parameter in
        {| t.level := level; t.delegate := delegate; t.priority := priority;
          t.timestamp := timestamp |}) None
      (obj4 (req None None "level" % string Raw_level.encoding)
        (req None None "delegate" % string Signature.Public_key_hash.encoding)
        (req None None "priority" % string uint16)
        (opt None None "estimated_time" % string Timestamp.encoding)).
  
  Module S.
    Import Data_encoding.
    
    Definition custom_root
      : Tezos_protocol_environment_alpha__Environment.RPC_path.path
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context :=
      op_div (op_div open_root "helpers" % string) "baking_rights" % string.
    
    Module baking_rights_query.
      Record record := {
        levels : list Tezos_raw_protocol_alpha.Alpha_context.Raw_level.t;
        cycles : list Tezos_raw_protocol_alpha.Alpha_context.Cycle.t;
        delegates :
          list
            Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t;
        max_priority : option Z;
        all : bool }.
    End baking_rights_query.
    Definition baking_rights_query := baking_rights_query.record.
    
    Definition baking_rights_query
      : Tezos_protocol_environment_alpha__Environment.RPC_query.t
        baking_rights_query :=
      op_pipegt
        (op_pipeplus
          (op_pipeplus
            (op_pipeplus
              (op_pipeplus
                (op_pipeplus
                  (__query_value
                    (fun levels =>
                      fun cycles =>
                        fun delegates =>
                          fun max_priority =>
                            fun all =>
                              {| baking_rights_query.levels := levels;
                                baking_rights_query.cycles := cycles;
                                baking_rights_query.delegates := delegates;
                                baking_rights_query.max_priority := max_priority;
                                baking_rights_query.all := all |}))
                  (multi_field None "level" % string Raw_level.rpc_arg
                    (fun t => baking_rights_query.levels t)))
                (multi_field None "cycle" % string Cycle.rpc_arg
                  (fun t => baking_rights_query.cycles t)))
              (multi_field None "delegate" % string
                Signature.Public_key_hash.rpc_arg
                (fun t => baking_rights_query.delegates t)))
            (opt_field None "max_priority" % string RPC_arg.int
              (fun t => baking_rights_query.max_priority t)))
          (flag None "all" % string (fun t => baking_rights_query.all t))) seal.
    
    Definition baking_rights
      : Tezos_protocol_environment_alpha__Environment.RPC_service.service
        (* `GET *) unit
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
        baking_rights_query unit (list t) :=
      RPC_service.get_service
        (Some
          "Retrieves the list of delegates allowed to bake a block.
By default, it gives the best baking priorities for bakers that have at least one opportunity below the 64th priority for the next block.
Parameters `level` and `cycle` can be used to specify the (valid) level(s) in the past or future at which the baking rights have to be returned. Parameter `delegate` can be used to restrict the results to the given delegates. If parameter `all` is set, all the baking opportunities for each baker at each level are returned, instead of just the first one.
Returns the list of baking slots. Also returns the minimal timestamps that correspond to these slots. The timestamps are omitted for levels in the past, and are only estimates for levels later that the next block, based on the hypothesis that all predecessor blocks were baked at the first priority."
            % string) baking_rights_query (__list_value None encoding)
        custom_root.
  End S.
  
  Definition baking_priorities
    (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
    (max_prio : Tezos_protocol_environment_alpha__Environment.Compare.Int.t)
    (function_parameter :
      Tezos_raw_protocol_alpha.Alpha_context.Level.t *
        option Tezos_protocol_environment_alpha__Environment.Time.t)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (list t)) :=
    let '(level, pred_timestamp) := function_parameter in
    op_gtgteqquestion (Baking.baking_priorities ctxt level)
      (fun contract_list =>
        let fix loop
          (l :
          Tezos_raw_protocol_alpha.Misc.lazy_list_t
            Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t)
          (acc : list t) (priority :
          Tezos_protocol_environment_alpha__Environment.Compare.Int.t)
          : Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
              (list t)) :=
          if op_gteq priority max_prio then
            __return (List.rev acc)
          else
            let 'Tezos_raw_protocol_alpha.Misc.LCons pk next := l in
            let delegate := Signature.Public_key.__hash_value pk in
            op_gtgteqquestion
              match pred_timestamp with
              | None => return_none
              | Some pred_timestamp =>
                op_gtgteqquestion
                  (Baking.minimal_time ctxt priority pred_timestamp)
                  (fun t => return_some t)
              end
              (fun timestamp =>
                let acc :=
                  cons
                    {|
                      t.level :=
                        Tezos_raw_protocol_alpha.Alpha_context.Level.t.level
                          level; t.delegate := delegate; t.priority := priority;
                      t.timestamp := timestamp |} acc in
                op_gtgteqquestion (next tt)
                  (fun l => loop l acc (op_plus priority 1))) in
        loop contract_list [] 0).
  
  Definition remove_duplicated_delegates (rights : list t) : list t :=
    op_atat List.rev
      (op_atat fst
        (List.fold_left
          (fun function_parameter =>
            let '(acc, previous) := function_parameter in
            fun r =>
              if Signature.Public_key_hash.__Set.mem (t.delegate r) previous
                then
                (acc, previous)
              else
                ((cons r acc),
                  (Signature.Public_key_hash.__Set.add (t.delegate r) previous)))
          ([], Signature.Public_key_hash.__Set.empty) rights)).
  
  Definition register (function_parameter : unit) : unit :=
    let 'tt := function_parameter in
    register0 S.baking_rights
      (fun ctxt =>
        fun q =>
          fun function_parameter =>
            let 'tt := function_parameter in
            op_gtgteqquestion
              (requested_levels
                ((Level.succ ctxt (Level.current ctxt)),
                  (Some (Timestamp.current ctxt))) ctxt
                (S.baking_rights_query.cycles q)
                (S.baking_rights_query.levels q))
              (fun levels =>
                let max_priority :=
                  match S.baking_rights_query.max_priority q with
                  | None => 64
                  | Some max => max
                  end in
                op_gtgteqquestion
                  (map_s (baking_priorities ctxt max_priority) levels)
                  (fun rights =>
                    let rights :=
                      if S.baking_rights_query.all q then
                        rights
                      else
                        List.map remove_duplicated_delegates rights in
                    let rights := List.concat rights in
                    match S.baking_rights_query.delegates q with
                    | [] => __return rights
                    | (cons _ _) as delegates =>
                      let is_requested (p : t) : bool :=
                        List.__exists
                          (Signature.Public_key_hash.equal (t.delegate p))
                          delegates in
                      __return (List.filter is_requested rights)
                    end))).
  
  Definition get {D E G I K L a b c i o q : Set}
    (ctxt :
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
          (* `POST *) unit + (* `PUT *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
      D -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (E * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
            (* `POST *) unit + (* `PUT *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i
          o -> D -> a -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (G * a * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
              (* `POST *) unit + (* `PUT *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
              b) q i o -> D -> a -> b -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (I * a * b * q * i * o)) *
            (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
              ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
                (* `POST *) unit + (* `PUT *) unit)
              Tezos_protocol_environment_alpha__Environment.RPC_context.t
              (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
                * b) * c) q i o -> D -> a -> b -> c -> q -> i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (K * a * b * c * q * i * o)) * L)))) * L * D)
    (op_staroptstar :
      option (list Tezos_raw_protocol_alpha.Alpha_context.Raw_level.t))
    : option (list Tezos_raw_protocol_alpha.Alpha_context.Cycle.t) ->
    option
      (list
        Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
    -> option bool -> option Z -> D ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        (list t)) :=
    let levels :=
      match op_staroptstar with
      | Some op_starsthstar => op_starsthstar
      | None => []
      end in
    fun op_staroptstar =>
      let cycles :=
        match op_staroptstar with
        | Some op_starsthstar => op_starsthstar
        | None => []
        end in
      fun op_staroptstar =>
        let delegates :=
          match op_staroptstar with
          | Some op_starsthstar => op_starsthstar
          | None => []
          end in
        fun op_staroptstar =>
          let all :=
            match op_staroptstar with
            | Some op_starsthstar => op_starsthstar
            | None => false
            end in
          fun max_priority =>
            fun block =>
              RPC_context.make_call0 S.baking_rights ctxt block
                {| S.baking_rights_query.levels := levels;
                  S.baking_rights_query.cycles := cycles;
                  S.baking_rights_query.delegates := delegates;
                  S.baking_rights_query.max_priority := max_priority;
                  S.baking_rights_query.all := all |} tt.
End Baking_rights.

Module Endorsing_rights.
  Module t.
    Record record := {
      level : Tezos_raw_protocol_alpha.Alpha_context.Raw_level.t;
      delegate :
        Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t;
      slots : list Z;
      estimated_time :
        option Tezos_protocol_environment_alpha__Environment.Time.t }.
  End t.
  Definition t := t.record.
  
  Definition encoding
    : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding t :=
    conv
      (fun function_parameter =>
        let '{|
          t.level := level;
            t.delegate := delegate;
            t.slots := slots;
            t.estimated_time := estimated_time
            |} := function_parameter in
        (level, delegate, slots, estimated_time))
      (fun function_parameter =>
        let '(level, delegate, slots, estimated_time) := function_parameter in
        {| t.level := level; t.delegate := delegate; t.slots := slots;
          t.estimated_time := estimated_time |}) None
      (obj4 (req None None "level" % string Raw_level.encoding)
        (req None None "delegate" % string Signature.Public_key_hash.encoding)
        (req None None "slots" % string (__list_value None uint16))
        (opt None None "estimated_time" % string Timestamp.encoding)).
  
  Module S.
    Import Data_encoding.
    
    Definition custom_root
      : Tezos_protocol_environment_alpha__Environment.RPC_path.path
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context :=
      op_div (op_div open_root "helpers" % string) "endorsing_rights" % string.
    
    Module endorsing_rights_query.
      Record record := {
        levels : list Tezos_raw_protocol_alpha.Alpha_context.Raw_level.t;
        cycles : list Tezos_raw_protocol_alpha.Alpha_context.Cycle.t;
        delegates :
          list
            Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t }.
    End endorsing_rights_query.
    Definition endorsing_rights_query := endorsing_rights_query.record.
    
    Definition endorsing_rights_query
      : Tezos_protocol_environment_alpha__Environment.RPC_query.t
        endorsing_rights_query :=
      op_pipegt
        (op_pipeplus
          (op_pipeplus
            (op_pipeplus
              (__query_value
                (fun levels =>
                  fun cycles =>
                    fun delegates =>
                      {| endorsing_rights_query.levels := levels;
                        endorsing_rights_query.cycles := cycles;
                        endorsing_rights_query.delegates := delegates |}))
              (multi_field None "level" % string Raw_level.rpc_arg
                (fun t => endorsing_rights_query.levels t)))
            (multi_field None "cycle" % string Cycle.rpc_arg
              (fun t => endorsing_rights_query.cycles t)))
          (multi_field None "delegate" % string
            Signature.Public_key_hash.rpc_arg
            (fun t => endorsing_rights_query.delegates t))) seal.
    
    Definition endorsing_rights
      : Tezos_protocol_environment_alpha__Environment.RPC_service.service
        (* `GET *) unit
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
        endorsing_rights_query unit (list t) :=
      RPC_service.get_service
        (Some
          "Retrieves the delegates allowed to endorse a block.
By default, it gives the endorsement slots for delegates that have at least one in the next block.
Parameters `level` and `cycle` can be used to specify the (valid) level(s) in the past or future at which the endorsement rights have to be returned. Parameter `delegate` can be used to restrict the results to the given delegates.
Returns the list of endorsement slots. Also returns the minimal timestamps that correspond to these slots. The timestamps are omitted for levels in the past, and are only estimates for levels later that the next block, based on the hypothesis that all predecessor blocks were baked at the first priority."
            % string) endorsing_rights_query (__list_value None encoding)
        custom_root.
  End S.
  
  Definition endorsement_slots
    (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
    (function_parameter :
      Tezos_raw_protocol_alpha.Alpha_context.Level.t *
        option Tezos_protocol_environment_alpha__Environment.Time.t)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (list t)) :=
    let '(level, estimated_time) := function_parameter in
    op_gtgteqquestion (Baking.endorsement_rights ctxt level)
      (fun rights =>
        __return
          (Signature.Public_key_hash.Map.fold
            (fun delegate =>
              fun function_parameter =>
                let '(_, slots, _) := function_parameter in
                fun acc =>
                  cons
                    {|
                      t.level :=
                        Tezos_raw_protocol_alpha.Alpha_context.Level.t.level
                          level; t.delegate := delegate; t.slots := slots;
                      t.estimated_time := estimated_time |} acc) rights [])).
  
  Definition register (function_parameter : unit) : unit :=
    let 'tt := function_parameter in
    register0 S.endorsing_rights
      (fun ctxt =>
        fun q =>
          fun function_parameter =>
            let 'tt := function_parameter in
            op_gtgteqquestion
              (requested_levels
                ((Level.current ctxt), (Some (Timestamp.current ctxt))) ctxt
                (S.endorsing_rights_query.cycles q)
                (S.endorsing_rights_query.levels q))
              (fun levels =>
                op_gtgteqquestion (map_s (endorsement_slots ctxt) levels)
                  (fun rights =>
                    let rights := List.concat rights in
                    match S.endorsing_rights_query.delegates q with
                    | [] => __return rights
                    | (cons _ _) as delegates =>
                      let is_requested (p : t) : bool :=
                        List.__exists
                          (Signature.Public_key_hash.equal (t.delegate p))
                          delegates in
                      __return (List.filter is_requested rights)
                    end))).
  
  Definition get {D E G I K L a b c i o q : Set}
    (ctxt :
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
          (* `POST *) unit + (* `PUT *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
      D -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (E * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
            (* `POST *) unit + (* `PUT *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i
          o -> D -> a -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (G * a * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
              (* `POST *) unit + (* `PUT *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
              b) q i o -> D -> a -> b -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (I * a * b * q * i * o)) *
            (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
              ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
                (* `POST *) unit + (* `PUT *) unit)
              Tezos_protocol_environment_alpha__Environment.RPC_context.t
              (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
                * b) * c) q i o -> D -> a -> b -> c -> q -> i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (K * a * b * c * q * i * o)) * L)))) * L * D)
    (op_staroptstar :
      option (list Tezos_raw_protocol_alpha.Alpha_context.Raw_level.t))
    : option (list Tezos_raw_protocol_alpha.Alpha_context.Cycle.t) ->
    option
      (list
        Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
    -> D ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        (list t)) :=
    let levels :=
      match op_staroptstar with
      | Some op_starsthstar => op_starsthstar
      | None => []
      end in
    fun op_staroptstar =>
      let cycles :=
        match op_staroptstar with
        | Some op_starsthstar => op_starsthstar
        | None => []
        end in
      fun op_staroptstar =>
        let delegates :=
          match op_staroptstar with
          | Some op_starsthstar => op_starsthstar
          | None => []
          end in
        fun block =>
          RPC_context.make_call0 S.endorsing_rights ctxt block
            {| S.endorsing_rights_query.levels := levels;
              S.endorsing_rights_query.cycles := cycles;
              S.endorsing_rights_query.delegates := delegates |} tt.
End Endorsing_rights.

Module Endorsing_power.
  Definition endorsing_power
    (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
    (function_parameter :
      Tezos_raw_protocol_alpha.Alpha_context.packed_operation *
        Tezos_protocol_environment_alpha__Environment.Chain_id.t)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult Z) :=
    let '(operation, chain_id) := function_parameter in
    let 'Tezos_raw_protocol_alpha.Alpha_context.Operation_data data :=
      Tezos_raw_protocol_alpha.Alpha_context.packed_operation.protocol_data
        operation in
    match Tezos_raw_protocol_alpha.Alpha_context.protocol_data.contents data
      with
    |
      Tezos_raw_protocol_alpha.Alpha_context.Single
        (Tezos_raw_protocol_alpha.Alpha_context.Endorsement _) =>
      op_gtgteqquestion
        (Baking.check_endorsement_rights ctxt chain_id
          {|
            Tezos_raw_protocol_alpha.Alpha_context.operation.shell :=
              Tezos_raw_protocol_alpha.Alpha_context.packed_operation.shell
                operation;
            Tezos_raw_protocol_alpha.Alpha_context.operation.protocol_data :=
              data |})
        (fun function_parameter =>
          let '(_, slots, _) := function_parameter in
          __return (List.length slots))
    | _ => failwith "Operation is not an endorsement" % string
    end.
  
  Module S.
    Definition endorsing_power
      : Tezos_protocol_environment_alpha__Environment.RPC_service.service
        (* `POST *) unit
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context unit
        (Tezos_raw_protocol_alpha.Alpha_context.Operation.packed *
          Tezos_protocol_environment_alpha__Environment.Chain_id.t) Z :=
      RPC_service.post_service
        (Some
          "Get the endorsing power of an endorsement, that is, the number of slots that the endorser has"
            % string) RPC_query.empty
        (obj2
          (req None None "endorsement_operation" % string Operation.encoding)
          (req None None "chain_id" % string Chain_id.encoding)) int31
        (op_div open_root "endorsing_power" % string).
  End S.
  
  Definition register (function_parameter : unit) : unit :=
    let 'tt := function_parameter in
    register0 S.endorsing_power
      (fun ctxt =>
        fun function_parameter =>
          let 'tt := function_parameter in
          fun function_parameter =>
            let '(op, chain_id) := function_parameter in
            endorsing_power ctxt (op, chain_id)).
  
  Definition get {D E G I K L a b c i o q : Set}
    (ctxt :
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
          (* `POST *) unit + (* `PUT *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
      D -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (E * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
            (* `POST *) unit + (* `PUT *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i
          o -> D -> a -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (G * a * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
              (* `POST *) unit + (* `PUT *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
              b) q i o -> D -> a -> b -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (I * a * b * q * i * o)) *
            (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
              ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
                (* `POST *) unit + (* `PUT *) unit)
              Tezos_protocol_environment_alpha__Environment.RPC_context.t
              (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
                * b) * c) q i o -> D -> a -> b -> c -> q -> i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (K * a * b * c * q * i * o)) * L)))) * L * D) (block : D)
    (op : Tezos_raw_protocol_alpha.Alpha_context.Operation.packed)
    (chain_id : Tezos_protocol_environment_alpha__Environment.Chain_id.t)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        Z) :=
    RPC_context.make_call0 S.endorsing_power ctxt block tt (op, chain_id).
End Endorsing_power.

Module Required_endorsements.
  Definition required_endorsements
    (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
    (block_delay : Tezos_raw_protocol_alpha.Alpha_context.Period.t)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult Z) :=
    __return (Baking.minimum_allowed_endorsements ctxt block_delay).
  
  Module S.
    Module t.
      Record record := {
        block_delay : Tezos_raw_protocol_alpha.Alpha_context.Period.t }.
    End t.
    Definition t := t.record.
    
    Definition required_endorsements_query
      : Tezos_protocol_environment_alpha__Environment.RPC_query.t t :=
      op_pipegt
        (op_pipeplus
          (__query_value (fun block_delay => {| t.block_delay := block_delay |}))
          (__field_value None "block_delay" % string Period.rpc_arg Period.zero
            (fun t => t.block_delay t))) seal.
    
    Definition required_endorsements
      : Tezos_protocol_environment_alpha__Environment.RPC_service.service
        (* `GET *) unit
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context t unit
        Z :=
      RPC_service.get_service
        (Some
          "Minimum number of endorsements for a block to be valid, given a delay of the block's timestamp with respect to the minimum time to bake at the block's priority"
            % string) required_endorsements_query int31
        (op_div open_root "required_endorsements" % string).
  End S.
  
  Definition register (function_parameter : unit) : unit :=
    let 'tt := function_parameter in
    register0 S.required_endorsements
      (fun ctxt =>
        fun function_parameter =>
          let '{| S.t.block_delay := block_delay |} := function_parameter in
          fun function_parameter =>
            let 'tt := function_parameter in
            required_endorsements ctxt block_delay).
  
  Definition get {D E G I K L a b c i o q : Set}
    (ctxt :
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
          (* `POST *) unit + (* `PUT *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
      D -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (E * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
            (* `POST *) unit + (* `PUT *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i
          o -> D -> a -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (G * a * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
              (* `POST *) unit + (* `PUT *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
              b) q i o -> D -> a -> b -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (I * a * b * q * i * o)) *
            (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
              ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
                (* `POST *) unit + (* `PUT *) unit)
              Tezos_protocol_environment_alpha__Environment.RPC_context.t
              (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
                * b) * c) q i o -> D -> a -> b -> c -> q -> i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (K * a * b * c * q * i * o)) * L)))) * L * D) (block : D)
    (block_delay : Tezos_raw_protocol_alpha.Alpha_context.Period.t)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        Z) :=
    RPC_context.make_call0 S.required_endorsements ctxt block
      {| S.t.block_delay := block_delay |} tt.
End Required_endorsements.

Module Minimal_valid_time.
  Definition minimal_valid_time
    (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context) (priority : Z)
    (endorsing_power : Z)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        Tezos_protocol_environment_alpha__Environment.Time.t) :=
    Baking.minimal_valid_time ctxt priority endorsing_power.
  
  Module S.
    Module t.
      Record record := {
        priority : Z;
        endorsing_power : Z }.
    End t.
    Definition t := t.record.
    
    Definition minimal_valid_time_query
      : Tezos_protocol_environment_alpha__Environment.RPC_query.t t :=
      op_pipegt
        (op_pipeplus
          (op_pipeplus
            (__query_value
              (fun priority =>
                fun endorsing_power =>
                  {| t.priority := priority;
                    t.endorsing_power := endorsing_power |}))
            (__field_value None "priority" % string RPC_arg.int 0
              (fun t => t.priority t)))
          (__field_value None "endorsing_power" % string RPC_arg.int 0
            (fun t => t.endorsing_power t))) seal.
    
    Definition minimal_valid_time
      : Tezos_protocol_environment_alpha__Environment.RPC_service.service
        (* `GET *) unit
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context t unit
        Tezos_protocol_environment_alpha__Environment.Time.t :=
      RPC_service.get_service
        (Some
          "Minimal valid time for a block given a priority and an endorsing power."
            % string) minimal_valid_time_query Time.encoding
        (op_div open_root "minimal_valid_time" % string).
  End S.
  
  Definition register (function_parameter : unit) : unit :=
    let 'tt := function_parameter in
    register0 S.minimal_valid_time
      (fun ctxt =>
        fun function_parameter =>
          let '{|
            S.t.priority := priority;
              S.t.endorsing_power := endorsing_power
              |} := function_parameter in
          fun function_parameter =>
            let 'tt := function_parameter in
            minimal_valid_time ctxt priority endorsing_power).
  
  Definition get {D E G I K L a b c i o q : Set}
    (ctxt :
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
          (* `POST *) unit + (* `PUT *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
      D -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (E * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
            (* `POST *) unit + (* `PUT *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i
          o -> D -> a -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (G * a * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
              (* `POST *) unit + (* `PUT *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
              b) q i o -> D -> a -> b -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (I * a * b * q * i * o)) *
            (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
              ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
                (* `POST *) unit + (* `PUT *) unit)
              Tezos_protocol_environment_alpha__Environment.RPC_context.t
              (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
                * b) * c) q i o -> D -> a -> b -> c -> q -> i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (K * a * b * c * q * i * o)) * L)))) * L * D) (block : D)
    (priority : Z) (endorsing_power : Z)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        Tezos_protocol_environment_alpha__Environment.Time.t) :=
    RPC_context.make_call0 S.minimal_valid_time ctxt block
      {| S.t.priority := priority; S.t.endorsing_power := endorsing_power |} tt.
End Minimal_valid_time.

Definition register (function_parameter : unit) : unit :=
  let 'tt := function_parameter in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ := register tt in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ := Baking_rights.register tt in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ := Endorsing_rights.register tt in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ := Endorsing_power.register tt in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ := Required_endorsements.register tt in
  Minimal_valid_time.register tt.

Definition endorsement_rights
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
  (level : Tezos_raw_protocol_alpha.Alpha_context.Level.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (list
        Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)) :=
  op_gtgteqquestion (Endorsing_rights.endorsement_slots ctxt (level, None))
    (fun l =>
      __return
        (List.map
          (fun function_parameter =>
            let '{| Endorsing_rights.t.delegate := delegate |} :=
              function_parameter in
            delegate) l)).

Definition baking_rights
  (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
  (max_priority :
    option Tezos_protocol_environment_alpha__Environment.Compare.Int.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha__Alpha_context.Raw_level.t *
        list
          (Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t
            * option Tezos_raw_protocol_alpha.Alpha_context.Timestamp.t))) :=
  let max :=
    match max_priority with
    | None => 64
    | Some m => m
    end in
  let level := Level.current ctxt in
  op_gtgteqquestion (Baking_rights.baking_priorities ctxt max (level, None))
    (fun l =>
      __return
        ((Tezos_raw_protocol_alpha.Alpha_context.Level.t.level level),
          (List.map
            (fun function_parameter =>
              let '{|
                Baking_rights.t.delegate := delegate;
                  Baking_rights.t.timestamp := timestamp
                  |} := function_parameter in
              (delegate, timestamp)) l))).

Definition endorsing_power
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
  (operation :
    Tezos_raw_protocol_alpha.Alpha_context.packed_operation *
      Tezos_protocol_environment_alpha__Environment.Chain_id.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult Z) :=
  Endorsing_power.endorsing_power ctxt operation.

Definition required_endorsements
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
  (delay : Tezos_raw_protocol_alpha.Alpha_context.Period.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult Z) :=
  Required_endorsements.required_endorsements ctxt delay.

Definition minimal_valid_time
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context) (priority : Z)
  (endorsing_power : Z)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_protocol_environment_alpha__Environment.Time.t) :=
  Minimal_valid_time.minimal_valid_time ctxt priority endorsing_power.

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Alpha_context

val list :
  'a #RPC_context.simple ->
  'a ->
  ?active:bool ->
  ?inactive:bool ->
  unit ->
  Signature.Public_key_hash.t list shell_tzresult Lwt.t

type info = {
  balance : Tez.t;
  frozen_balance : Tez.t;
  frozen_balance_by_cycle : Delegate.frozen_balance Cycle.Map.t;
  staking_balance : Tez.t;
  delegated_contracts : Contract_repr.t list;
  delegated_balance : Tez.t;
  deactivated : bool;
  grace_period : Cycle.t;
}

val info_encoding : info Data_encoding.t

val info :
  'a #RPC_context.simple ->
  'a ->
  Signature.Public_key_hash.t ->
  info shell_tzresult Lwt.t

val balance :
  'a #RPC_context.simple ->
  'a ->
  Signature.Public_key_hash.t ->
  Tez.t shell_tzresult Lwt.t

val frozen_balance :
  'a #RPC_context.simple ->
  'a ->
  Signature.Public_key_hash.t ->
  Tez.t shell_tzresult Lwt.t

val frozen_balance_by_cycle :
  'a #RPC_context.simple ->
  'a ->
  Signature.Public_key_hash.t ->
  Delegate.frozen_balance Cycle.Map.t shell_tzresult Lwt.t

val staking_balance :
  'a #RPC_context.simple ->
  'a ->
  Signature.Public_key_hash.t ->
  Tez.t shell_tzresult Lwt.t

val delegated_contracts :
  'a #RPC_context.simple ->
  'a ->
  Signature.Public_key_hash.t ->
  Contract_repr.t list shell_tzresult Lwt.t

val delegated_balance :
  'a #RPC_context.simple ->
  'a ->
  Signature.Public_key_hash.t ->
  Tez.t shell_tzresult Lwt.t

val deactivated :
  'a #RPC_context.simple ->
  'a ->
  Signature.Public_key_hash.t ->
  bool shell_tzresult Lwt.t

val grace_period :
  'a #RPC_context.simple ->
  'a ->
  Signature.Public_key_hash.t ->
  Cycle.t shell_tzresult Lwt.t

module Baking_rights : sig
  type t = {
    level : Raw_level.t;
    delegate : Signature.Public_key_hash.t;
    priority : int;
    timestamp : Timestamp.t option;
  }

  (** Retrieves the list of delegates allowed to bake a block.

      By default, it gives the best baking priorities for bakers
      that have at least one opportunity below the 64th priority for
      the next block.

      Parameters [levels] and [cycles] can be used to specify the
      (valid) level(s) in the past or future at which the baking rights
      have to be returned. Parameter [delegates] can be used to
      restrict the results to the given delegates. If parameter [all]
      is [true], all the baking opportunities for each baker at each level
      are returned, instead of just the first one.

      Returns the list of baking slots. Also returns the minimal
      timestamps that correspond to these slots. The timestamps are
      omitted for levels in the past, and are only estimates for levels
      later that the next block, based on the hypothesis that all
      predecessor blocks were baked at the first priority. *)
  val get :
    'a #RPC_context.simple ->
    ?levels:Raw_level.t list ->
    ?cycles:Cycle.t list ->
    ?delegates:Signature.public_key_hash list ->
    ?all:bool ->
    ?max_priority:int ->
    'a ->
    t list shell_tzresult Lwt.t
end

module Endorsing_rights : sig
  type t = {
    level : Raw_level.t;
    delegate : Signature.Public_key_hash.t;
    slots : int list;
    estimated_time : Timestamp.t option;
  }

  (** Retrieves the delegates allowed to endorse a block.

      By default, it gives the endorsement slots for bakers that have
      at least one in the next block.

      Parameters [levels] and [cycles] can be used to specify the
      (valid) level(s) in the past or future at which the endorsement
      rights have to be returned. Parameter [delegates] can be used to
      restrict the results to the given delegates.  Returns the list of
      endorsement slots. Also returns the minimal timestamps that
      correspond to these slots.

      Timestamps are omitted for levels in the past, and are only
      estimates for levels later that the next block, based on the
      hypothesis that all predecessor blocks were baked at the first
      priority. *)
  val get :
    'a #RPC_context.simple ->
    ?levels:Raw_level.t list ->
    ?cycles:Cycle.t list ->
    ?delegates:Signature.public_key_hash list ->
    'a ->
    t list shell_tzresult Lwt.t
end

module Endorsing_power : sig
  val get :
    'a #RPC_context.simple ->
    'a ->
    Alpha_context.packed_operation ->
    Chain_id.t ->
    int shell_tzresult Lwt.t
end

module Required_endorsements : sig
  val get :
    'a #RPC_context.simple -> 'a -> Period.t -> int shell_tzresult Lwt.t
end

module Minimal_valid_time : sig
  val get :
    'a #RPC_context.simple -> 'a -> int -> int -> Time.t shell_tzresult Lwt.t
end

(* temporary export for deprecated unit test *)
val endorsement_rights :
  Alpha_context.t -> Level.t -> public_key_hash list tzresult Lwt.t

val baking_rights :
  Alpha_context.t ->
  int option ->
  (Raw_level.t * (public_key_hash * Time.t option) list) tzresult Lwt.t

val endorsing_power :
  Alpha_context.t ->
  Alpha_context.packed_operation * Chain_id.t ->
  int tzresult Lwt.t

val required_endorsements :
  Alpha_context.t -> Alpha_context.Period.t -> int tzresult Lwt.t

val minimal_valid_time : Alpha_context.t -> int -> int -> Time.t tzresult Lwt.t

val register : unit -> unit

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Parameter __list_value : forall {E F H J K a b c i o q : Set},
  (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
    ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit +
      (* `PATCH *) unit)
    Tezos_protocol_environment_alpha__Environment.RPC_context.t
    Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> a ->
  q -> i ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult o))
    * (E * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit
        + (* `PATCH *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
    a -> a -> q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (F * a * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
          (* `POST *) unit + (* `PATCH *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
        q i o -> a -> a -> b -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (H * a * b * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
            (* `POST *) unit + (* `PATCH *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
            b) * c) q i o -> a -> a -> b -> c -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (J * a * b * c * q * i * o)) * K)))) * K * a -> a ->
  option bool -> option bool -> unit ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      (list
        Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)).

Module info.
  Record record := {
    balance : Tezos_raw_protocol_alpha.Alpha_context.Tez.t;
    frozen_balance : Tezos_raw_protocol_alpha.Alpha_context.Tez.t;
    frozen_balance_by_cycle :
      Tezos_raw_protocol_alpha.Alpha_context.Cycle.Map.t
        Tezos_raw_protocol_alpha.Alpha_context.Delegate.frozen_balance;
    staking_balance : Tezos_raw_protocol_alpha.Alpha_context.Tez.t;
    delegated_contracts : list Tezos_raw_protocol_alpha.Contract_repr.t;
    delegated_balance : Tezos_raw_protocol_alpha.Alpha_context.Tez.t;
    deactivated : bool;
    grace_period : Tezos_raw_protocol_alpha.Alpha_context.Cycle.t }.
End info.
Definition info := info.record.

Parameter info_encoding :
  Tezos_protocol_environment_alpha__Environment.Data_encoding.t info.

Parameter info : forall {E F H J K a b c i o q : Set},
  (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
    ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit +
      (* `PATCH *) unit)
    Tezos_protocol_environment_alpha__Environment.RPC_context.t
    Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> a ->
  q -> i ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult o))
    * (E * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit
        + (* `PATCH *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
    a -> a -> q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (F * a * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
          (* `POST *) unit + (* `PATCH *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
        q i o -> a -> a -> b -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (H * a * b * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
            (* `POST *) unit + (* `PATCH *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
            b) * c) q i o -> a -> a -> b -> c -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (J * a * b * c * q * i * o)) * K)))) * K * a -> a ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      info).

Parameter balance : forall {E F H J K a b c i o q : Set},
  (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
    ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit +
      (* `PATCH *) unit)
    Tezos_protocol_environment_alpha__Environment.RPC_context.t
    Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> a ->
  q -> i ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult o))
    * (E * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit
        + (* `PATCH *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
    a -> a -> q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (F * a * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
          (* `POST *) unit + (* `PATCH *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
        q i o -> a -> a -> b -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (H * a * b * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
            (* `POST *) unit + (* `PATCH *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
            b) * c) q i o -> a -> a -> b -> c -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (J * a * b * c * q * i * o)) * K)))) * K * a -> a ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      Tezos_raw_protocol_alpha.Alpha_context.Tez.t).

Parameter frozen_balance : forall {E F H J K a b c i o q : Set},
  (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
    ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit +
      (* `PATCH *) unit)
    Tezos_protocol_environment_alpha__Environment.RPC_context.t
    Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> a ->
  q -> i ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult o))
    * (E * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit
        + (* `PATCH *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
    a -> a -> q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (F * a * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
          (* `POST *) unit + (* `PATCH *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
        q i o -> a -> a -> b -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (H * a * b * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
            (* `POST *) unit + (* `PATCH *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
            b) * c) q i o -> a -> a -> b -> c -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (J * a * b * c * q * i * o)) * K)))) * K * a -> a ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      Tezos_raw_protocol_alpha.Alpha_context.Tez.t).

Parameter frozen_balance_by_cycle : forall {E F H J K a b c i o q : Set},
  (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
    ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit +
      (* `PATCH *) unit)
    Tezos_protocol_environment_alpha__Environment.RPC_context.t
    Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> a ->
  q -> i ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult o))
    * (E * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit
        + (* `PATCH *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
    a -> a -> q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (F * a * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
          (* `POST *) unit + (* `PATCH *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
        q i o -> a -> a -> b -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (H * a * b * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
            (* `POST *) unit + (* `PATCH *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
            b) * c) q i o -> a -> a -> b -> c -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (J * a * b * c * q * i * o)) * K)))) * K * a -> a ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      (Tezos_raw_protocol_alpha.Alpha_context.Cycle.Map.t
        Tezos_raw_protocol_alpha.Alpha_context.Delegate.frozen_balance)).

Parameter staking_balance : forall {E F H J K a b c i o q : Set},
  (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
    ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit +
      (* `PATCH *) unit)
    Tezos_protocol_environment_alpha__Environment.RPC_context.t
    Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> a ->
  q -> i ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult o))
    * (E * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit
        + (* `PATCH *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
    a -> a -> q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (F * a * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
          (* `POST *) unit + (* `PATCH *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
        q i o -> a -> a -> b -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (H * a * b * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
            (* `POST *) unit + (* `PATCH *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
            b) * c) q i o -> a -> a -> b -> c -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (J * a * b * c * q * i * o)) * K)))) * K * a -> a ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      Tezos_raw_protocol_alpha.Alpha_context.Tez.t).

Parameter delegated_contracts : forall {E F H J K a b c i o q : Set},
  (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
    ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit +
      (* `PATCH *) unit)
    Tezos_protocol_environment_alpha__Environment.RPC_context.t
    Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> a ->
  q -> i ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult o))
    * (E * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit
        + (* `PATCH *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
    a -> a -> q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (F * a * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
          (* `POST *) unit + (* `PATCH *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
        q i o -> a -> a -> b -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (H * a * b * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
            (* `POST *) unit + (* `PATCH *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
            b) * c) q i o -> a -> a -> b -> c -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (J * a * b * c * q * i * o)) * K)))) * K * a -> a ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      (list Tezos_raw_protocol_alpha.Contract_repr.t)).

Parameter delegated_balance : forall {E F H J K a b c i o q : Set},
  (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
    ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit +
      (* `PATCH *) unit)
    Tezos_protocol_environment_alpha__Environment.RPC_context.t
    Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> a ->
  q -> i ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult o))
    * (E * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit
        + (* `PATCH *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
    a -> a -> q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (F * a * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
          (* `POST *) unit + (* `PATCH *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
        q i o -> a -> a -> b -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (H * a * b * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
            (* `POST *) unit + (* `PATCH *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
            b) * c) q i o -> a -> a -> b -> c -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (J * a * b * c * q * i * o)) * K)))) * K * a -> a ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      Tezos_raw_protocol_alpha.Alpha_context.Tez.t).

Parameter deactivated : forall {E F H J K a b c i o q : Set},
  (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
    ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit +
      (* `PATCH *) unit)
    Tezos_protocol_environment_alpha__Environment.RPC_context.t
    Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> a ->
  q -> i ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult o))
    * (E * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit
        + (* `PATCH *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
    a -> a -> q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (F * a * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
          (* `POST *) unit + (* `PATCH *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
        q i o -> a -> a -> b -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (H * a * b * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
            (* `POST *) unit + (* `PATCH *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
            b) * c) q i o -> a -> a -> b -> c -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (J * a * b * c * q * i * o)) * K)))) * K * a -> a ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      bool).

Parameter grace_period : forall {E F H J K a b c i o q : Set},
  (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
    ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit +
      (* `PATCH *) unit)
    Tezos_protocol_environment_alpha__Environment.RPC_context.t
    Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> a ->
  q -> i ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult o))
    * (E * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit
        + (* `PATCH *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
    a -> a -> q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (F * a * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
          (* `POST *) unit + (* `PATCH *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
        q i o -> a -> a -> b -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (H * a * b * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
            (* `POST *) unit + (* `PATCH *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
            b) * c) q i o -> a -> a -> b -> c -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (J * a * b * c * q * i * o)) * K)))) * K * a -> a ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      Tezos_raw_protocol_alpha.Alpha_context.Cycle.t).

Module Baking_rights.
  Module t.
    Record record := {
      level : Tezos_raw_protocol_alpha.Alpha_context.Raw_level.t;
      delegate :
        Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t;
      priority : Z;
      timestamp : option Tezos_raw_protocol_alpha.Alpha_context.Timestamp.t }.
  End t.
  Definition t := t.record.
  
  Parameter get : forall {E F H J K a b c i o q : Set},
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit
        + (* `PATCH *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> a ->
    q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
          (* `POST *) unit + (* `PATCH *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
      -> a -> a -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (F * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
            (* `POST *) unit + (* `PATCH *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o -> a -> a -> b -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (H * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
              (* `POST *) unit + (* `PATCH *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o -> a -> a -> b -> c -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (J * a * b * c * q * i * o)) * K)))) * K * a ->
    option (list Tezos_raw_protocol_alpha.Alpha_context.Raw_level.t) ->
    option (list Tezos_raw_protocol_alpha.Alpha_context.Cycle.t) ->
    option
      (list
        Tezos_protocol_environment_alpha__Environment.Signature.public_key_hash)
    -> option bool -> option Z -> a ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        (list t)).
End Baking_rights.

Module Endorsing_rights.
  Module t.
    Record record := {
      level : Tezos_raw_protocol_alpha.Alpha_context.Raw_level.t;
      delegate :
        Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t;
      slots : list Z;
      estimated_time : option Tezos_raw_protocol_alpha.Alpha_context.Timestamp.t }.
  End t.
  Definition t := t.record.
  
  Parameter get : forall {E F H J K a b c i o q : Set},
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit
        + (* `PATCH *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> a ->
    q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
          (* `POST *) unit + (* `PATCH *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
      -> a -> a -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (F * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
            (* `POST *) unit + (* `PATCH *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o -> a -> a -> b -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (H * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
              (* `POST *) unit + (* `PATCH *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o -> a -> a -> b -> c -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (J * a * b * c * q * i * o)) * K)))) * K * a ->
    option (list Tezos_raw_protocol_alpha.Alpha_context.Raw_level.t) ->
    option (list Tezos_raw_protocol_alpha.Alpha_context.Cycle.t) ->
    option
      (list
        Tezos_protocol_environment_alpha__Environment.Signature.public_key_hash)
    -> a ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        (list t)).
End Endorsing_rights.

Module Endorsing_power.
  Parameter get : forall {E F H J K a b c i o q : Set},
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit
        + (* `PATCH *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> a ->
    q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
          (* `POST *) unit + (* `PATCH *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
      -> a -> a -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (F * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
            (* `POST *) unit + (* `PATCH *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o -> a -> a -> b -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (H * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
              (* `POST *) unit + (* `PATCH *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o -> a -> a -> b -> c -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (J * a * b * c * q * i * o)) * K)))) * K * a -> a ->
    Tezos_raw_protocol_alpha.Alpha_context.packed_operation ->
    Tezos_protocol_environment_alpha__Environment.Chain_id.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        Z).
End Endorsing_power.

Module Required_endorsements.
  Parameter get : forall {E F H J K a b c i o q : Set},
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit
        + (* `PATCH *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> a ->
    q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
          (* `POST *) unit + (* `PATCH *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
      -> a -> a -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (F * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
            (* `POST *) unit + (* `PATCH *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o -> a -> a -> b -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (H * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
              (* `POST *) unit + (* `PATCH *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o -> a -> a -> b -> c -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (J * a * b * c * q * i * o)) * K)))) * K * a -> a ->
    Tezos_raw_protocol_alpha.Alpha_context.Period.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        Z).
End Required_endorsements.

Module Minimal_valid_time.
  Parameter get : forall {E F H J K a b c i o q : Set},
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit
        + (* `PATCH *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> a ->
    q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
          (* `POST *) unit + (* `PATCH *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
      -> a -> a -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (F * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
            (* `POST *) unit + (* `PATCH *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o -> a -> a -> b -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (H * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
              (* `POST *) unit + (* `PATCH *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o -> a -> a -> b -> c -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (J * a * b * c * q * i * o)) * K)))) * K * a -> a -> Z ->
    Z ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        Tezos_protocol_environment_alpha__Environment.Time.t).
End Minimal_valid_time.

Parameter endorsement_rights :
  Tezos_raw_protocol_alpha.Alpha_context.t ->
  Tezos_raw_protocol_alpha.Alpha_context.Level.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (list Tezos_raw_protocol_alpha.Alpha_context.public_key_hash)).

Parameter baking_rights :
  Tezos_raw_protocol_alpha.Alpha_context.t -> option Z ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Alpha_context.Raw_level.t *
        list
          (Tezos_raw_protocol_alpha.Alpha_context.public_key_hash *
            option Tezos_protocol_environment_alpha__Environment.Time.t))).

Parameter endorsing_power :
  Tezos_raw_protocol_alpha.Alpha_context.t ->
  Tezos_raw_protocol_alpha.Alpha_context.packed_operation *
    Tezos_protocol_environment_alpha__Environment.Chain_id.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult Z).

Parameter required_endorsements :
  Tezos_raw_protocol_alpha.Alpha_context.t ->
  Tezos_raw_protocol_alpha.Alpha_context.Period.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult Z).

Parameter minimal_valid_time :
  Tezos_raw_protocol_alpha.Alpha_context.t -> Z -> Z ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_protocol_environment_alpha__Environment.Time.t).

Parameter register : unit -> unit.

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

type balance =
  | Contract of Contract_repr.t
  | Rewards of Signature.Public_key_hash.t * Cycle_repr.t
  | Fees of Signature.Public_key_hash.t * Cycle_repr.t
  | Deposits of Signature.Public_key_hash.t * Cycle_repr.t

let balance_encoding =
  let open Data_encoding in
  def "operation_metadata.alpha.balance"
  @@ union
       [ case
           (Tag 0)
           ~title:"Contract"
           (obj2
              (req "kind" (constant "contract"))
              (req "contract" Contract_repr.encoding))
           (function Contract c -> Some ((), c) | _ -> None)
           (fun ((), c) -> Contract c);
         case
           (Tag 1)
           ~title:"Rewards"
           (obj4
              (req "kind" (constant "freezer"))
              (req "category" (constant "rewards"))
              (req "delegate" Signature.Public_key_hash.encoding)
              (req "cycle" Cycle_repr.encoding))
           (function Rewards (d, l) -> Some ((), (), d, l) | _ -> None)
           (fun ((), (), d, l) -> Rewards (d, l));
         case
           (Tag 2)
           ~title:"Fees"
           (obj4
              (req "kind" (constant "freezer"))
              (req "category" (constant "fees"))
              (req "delegate" Signature.Public_key_hash.encoding)
              (req "cycle" Cycle_repr.encoding))
           (function Fees (d, l) -> Some ((), (), d, l) | _ -> None)
           (fun ((), (), d, l) -> Fees (d, l));
         case
           (Tag 3)
           ~title:"Deposits"
           (obj4
              (req "kind" (constant "freezer"))
              (req "category" (constant "deposits"))
              (req "delegate" Signature.Public_key_hash.encoding)
              (req "cycle" Cycle_repr.encoding))
           (function Deposits (d, l) -> Some ((), (), d, l) | _ -> None)
           (fun ((), (), d, l) -> Deposits (d, l)) ]

type balance_update = Debited of Tez_repr.t | Credited of Tez_repr.t

let balance_update_encoding =
  let open Data_encoding in
  def "operation_metadata.alpha.balance_update"
  @@ obj1
       (req
          "change"
          (conv
             (function
               | Credited v ->
                   Tez_repr.to_mutez v
               | Debited v ->
                   Int64.neg (Tez_repr.to_mutez v))
             ( Json.wrap_error
             @@ fun v ->
             if Compare.Int64.(v < 0L) then
               match Tez_repr.of_mutez (Int64.neg v) with
               | Some v ->
                   Debited v
               | None ->
                   failwith "Qty.of_mutez"
             else
               match Tez_repr.of_mutez v with
               | Some v ->
                   Credited v
               | None ->
                   failwith "Qty.of_mutez" )
             int64))

type balance_updates = (balance * balance_update) list

let balance_updates_encoding =
  let open Data_encoding in
  def "operation_metadata.alpha.balance_updates"
  @@ list (merge_objs balance_encoding balance_update_encoding)

let cleanup_balance_updates balance_updates =
  List.filter
    (fun (_, (Credited update | Debited update)) ->
      not (Tez_repr.equal update Tez_repr.zero))
    balance_updates

type frozen_balance = {
  deposit : Tez_repr.t;
  fees : Tez_repr.t;
  rewards : Tez_repr.t;
}

let frozen_balance_encoding =
  let open Data_encoding in
  conv
    (fun {deposit; fees; rewards} -> (deposit, fees, rewards))
    (fun (deposit, fees, rewards) -> {deposit; fees; rewards})
    (obj3
       (req "deposit" Tez_repr.encoding)
       (req "fees" Tez_repr.encoding)
       (req "rewards" Tez_repr.encoding))

type error +=
  | No_deletion of Signature.Public_key_hash.t (* `Permanent *)
  | Active_delegate (* `Temporary *)
  | Current_delegate (* `Temporary *)
  | Empty_delegate_account of Signature.Public_key_hash.t (* `Temporary *)
  | Balance_too_low_for_deposit of {
      delegate : Signature.Public_key_hash.t;
      deposit : Tez_repr.t;
      balance : Tez_repr.t;
    }

(* `Temporary *)

let () =
  register_error_kind
    `Permanent
    ~id:"delegate.no_deletion"
    ~title:"Forbidden delegate deletion"
    ~description:"Tried to unregister a delegate"
    ~pp:(fun ppf delegate ->
      Format.fprintf
        ppf
        "Delegate deletion is forbidden (%a)"
        Signature.Public_key_hash.pp
        delegate)
    Data_encoding.(obj1 (req "delegate" Signature.Public_key_hash.encoding))
    (function No_deletion c -> Some c | _ -> None)
    (fun c -> No_deletion c) ;
  register_error_kind
    `Temporary
    ~id:"delegate.already_active"
    ~title:"Delegate already active"
    ~description:"Useless delegate reactivation"
    ~pp:(fun ppf () ->
      Format.fprintf ppf "The delegate is still active, no need to refresh it")
    Data_encoding.empty
    (function Active_delegate -> Some () | _ -> None)
    (fun () -> Active_delegate) ;
  register_error_kind
    `Temporary
    ~id:"delegate.unchanged"
    ~title:"Unchanged delegated"
    ~description:"Contract already delegated to the given delegate"
    ~pp:(fun ppf () ->
      Format.fprintf
        ppf
        "The contract is already delegated to the same delegate")
    Data_encoding.empty
    (function Current_delegate -> Some () | _ -> None)
    (fun () -> Current_delegate) ;
  register_error_kind
    `Permanent
    ~id:"delegate.empty_delegate_account"
    ~title:"Empty delegate account"
    ~description:
      "Cannot register a delegate when its implicit account is empty"
    ~pp:(fun ppf delegate ->
      Format.fprintf
        ppf
        "Delegate registration is forbidden when the delegate\n\
        \           implicit account is empty (%a)"
        Signature.Public_key_hash.pp
        delegate)
    Data_encoding.(obj1 (req "delegate" Signature.Public_key_hash.encoding))
    (function Empty_delegate_account c -> Some c | _ -> None)
    (fun c -> Empty_delegate_account c) ;
  register_error_kind
    `Temporary
    ~id:"delegate.balance_too_low_for_deposit"
    ~title:"Balance too low for deposit"
    ~description:"Cannot freeze deposit when the balance is too low"
    ~pp:(fun ppf (delegate, balance, deposit) ->
      Format.fprintf
        ppf
        "Delegate %a has a too low balance (%a) to deposit %a"
        Signature.Public_key_hash.pp
        delegate
        Tez_repr.pp
        balance
        Tez_repr.pp
        deposit)
    Data_encoding.(
      obj3
        (req "delegate" Signature.Public_key_hash.encoding)
        (req "balance" Tez_repr.encoding)
        (req "deposit" Tez_repr.encoding))
    (function
      | Balance_too_low_for_deposit {delegate; balance; deposit} ->
          Some (delegate, balance, deposit)
      | _ ->
          None)
    (fun (delegate, balance, deposit) ->
      Balance_too_low_for_deposit {delegate; balance; deposit})

let link c contract delegate =
  Storage.Contract.Balance.get c contract
  >>=? fun balance ->
  Roll_storage.Delegate.add_amount c delegate balance
  >>=? fun c ->
  Storage.Contract.Delegated.add
    (c, Contract_repr.implicit_contract delegate)
    contract
  >>= fun c -> return c

let unlink c contract =
  Storage.Contract.Balance.get c contract
  >>=? fun balance ->
  Storage.Contract.Delegate.get_option c contract
  >>=? function
  | None ->
      return c
  | Some delegate ->
      (* Removes the balance of the contract from the delegate *)
      Roll_storage.Delegate.remove_amount c delegate balance
      >>=? fun c ->
      Storage.Contract.Delegated.del
        (c, Contract_repr.implicit_contract delegate)
        contract
      >>= fun c -> return c

let known c delegate =
  Storage.Contract.Manager.get_option
    c
    (Contract_repr.implicit_contract delegate)
  >>=? function
  | None | Some (Manager_repr.Hash _) ->
      return_false
  | Some (Manager_repr.Public_key _) ->
      return_true

(* A delegate is registered if its "implicit account" delegates to itself. *)
let registered c delegate =
  Storage.Contract.Delegate.get_option
    c
    (Contract_repr.implicit_contract delegate)
  >>=? function
  | Some current_delegate ->
      return @@ Signature.Public_key_hash.equal delegate current_delegate
  | None ->
      return_false

let init ctxt contract delegate =
  known ctxt delegate
  >>=? fun known_delegate ->
  fail_unless known_delegate (Roll_storage.Unregistered_delegate delegate)
  >>=? fun () ->
  registered ctxt delegate
  >>=? fun is_registered ->
  fail_unless is_registered (Roll_storage.Unregistered_delegate delegate)
  >>=? fun () ->
  Storage.Contract.Delegate.init ctxt contract delegate
  >>=? fun ctxt -> link ctxt contract delegate

let get = Roll_storage.get_contract_delegate

let set c contract delegate =
  match delegate with
  | None -> (
      let delete () =
        unlink c contract
        >>=? fun c ->
        Storage.Contract.Delegate.remove c contract >>= fun c -> return c
      in
      match Contract_repr.is_implicit contract with
      | Some pkh ->
          (* check if contract is a registered delegate *)
          registered c pkh
          >>=? fun is_registered ->
          if is_registered then fail (No_deletion pkh) else delete ()
      | None ->
          delete () )
  | Some delegate ->
      known c delegate
      >>=? fun known_delegate ->
      registered c delegate
      >>=? fun registered_delegate ->
      let self_delegation =
        match Contract_repr.is_implicit contract with
        | Some pkh ->
            Signature.Public_key_hash.equal pkh delegate
        | None ->
            false
      in
      if (not known_delegate) || not (registered_delegate || self_delegation)
      then fail (Roll_storage.Unregistered_delegate delegate)
      else
        Storage.Contract.Delegate.get_option c contract
        >>=? (function
               | Some current_delegate
                 when Signature.Public_key_hash.equal delegate current_delegate
                 ->
                   if self_delegation then
                     Roll_storage.Delegate.is_inactive c delegate
                     >>=? function
                     | true -> return_unit | false -> fail Active_delegate
                   else fail Current_delegate
               | None | Some _ ->
                   return_unit)
        >>=? fun () ->
        (* check if contract is a registered delegate *)
        ( match Contract_repr.is_implicit contract with
        | Some pkh ->
            registered c pkh
            >>=? fun is_registered ->
            (* allow self-delegation to re-activate *)
            if (not self_delegation) && is_registered then
              fail (No_deletion pkh)
            else return_unit
        | None ->
            return_unit )
        >>=? fun () ->
        Storage.Contract.Balance.mem c contract
        >>= fun exists ->
        fail_when
          (self_delegation && not exists)
          (Empty_delegate_account delegate)
        >>=? fun () ->
        unlink c contract
        >>=? fun c ->
        Storage.Contract.Delegate.init_set c contract delegate
        >>= fun c ->
        link c contract delegate
        >>=? fun c ->
        ( if self_delegation then
          Storage.Delegates.add c delegate
          >>= fun c ->
          Roll_storage.Delegate.set_active c delegate >>=? fun c -> return c
        else return c )
        >>=? fun c -> return c

let remove ctxt contract = unlink ctxt contract

let delegated_contracts ctxt delegate =
  let contract = Contract_repr.implicit_contract delegate in
  Storage.Contract.Delegated.elements (ctxt, contract)

let get_frozen_deposit ctxt contract cycle =
  Storage.Contract.Frozen_deposits.get_option (ctxt, contract) cycle
  >>=? function None -> return Tez_repr.zero | Some frozen -> return frozen

let credit_frozen_deposit ctxt delegate cycle amount =
  let contract = Contract_repr.implicit_contract delegate in
  get_frozen_deposit ctxt contract cycle
  >>=? fun old_amount ->
  Lwt.return Tez_repr.(old_amount +? amount)
  >>=? fun new_amount ->
  Storage.Contract.Frozen_deposits.init_set (ctxt, contract) cycle new_amount
  >>= fun ctxt ->
  Storage.Delegates_with_frozen_balance.add (ctxt, cycle) delegate
  >>= fun ctxt -> return ctxt

let freeze_deposit ctxt delegate amount =
  let {Level_repr.cycle; _} = Level_storage.current ctxt in
  Roll_storage.Delegate.set_active ctxt delegate
  >>=? fun ctxt ->
  let contract = Contract_repr.implicit_contract delegate in
  Storage.Contract.Balance.get ctxt contract
  >>=? fun balance ->
  Lwt.return
    (record_trace
       (Balance_too_low_for_deposit {delegate; deposit = amount; balance})
       Tez_repr.(balance -? amount))
  >>=? fun new_balance ->
  Storage.Contract.Balance.set ctxt contract new_balance
  >>=? fun ctxt -> credit_frozen_deposit ctxt delegate cycle amount

let get_frozen_fees ctxt contract cycle =
  Storage.Contract.Frozen_fees.get_option (ctxt, contract) cycle
  >>=? function None -> return Tez_repr.zero | Some frozen -> return frozen

let credit_frozen_fees ctxt delegate cycle amount =
  let contract = Contract_repr.implicit_contract delegate in
  get_frozen_fees ctxt contract cycle
  >>=? fun old_amount ->
  Lwt.return Tez_repr.(old_amount +? amount)
  >>=? fun new_amount ->
  Storage.Contract.Frozen_fees.init_set (ctxt, contract) cycle new_amount
  >>= fun ctxt ->
  Storage.Delegates_with_frozen_balance.add (ctxt, cycle) delegate
  >>= fun ctxt -> return ctxt

let freeze_fees ctxt delegate amount =
  let {Level_repr.cycle; _} = Level_storage.current ctxt in
  Roll_storage.Delegate.add_amount ctxt delegate amount
  >>=? fun ctxt -> credit_frozen_fees ctxt delegate cycle amount

let burn_fees ctxt delegate cycle amount =
  let contract = Contract_repr.implicit_contract delegate in
  get_frozen_fees ctxt contract cycle
  >>=? fun old_amount ->
  ( match Tez_repr.(old_amount -? amount) with
  | Ok new_amount ->
      Roll_storage.Delegate.remove_amount ctxt delegate amount
      >>=? fun ctxt -> return (new_amount, ctxt)
  | Error _ ->
      Roll_storage.Delegate.remove_amount ctxt delegate old_amount
      >>=? fun ctxt -> return (Tez_repr.zero, ctxt) )
  >>=? fun (new_amount, ctxt) ->
  Storage.Contract.Frozen_fees.init_set (ctxt, contract) cycle new_amount
  >>= fun ctxt -> return ctxt

let get_frozen_rewards ctxt contract cycle =
  Storage.Contract.Frozen_rewards.get_option (ctxt, contract) cycle
  >>=? function None -> return Tez_repr.zero | Some frozen -> return frozen

let credit_frozen_rewards ctxt delegate cycle amount =
  let contract = Contract_repr.implicit_contract delegate in
  get_frozen_rewards ctxt contract cycle
  >>=? fun old_amount ->
  Lwt.return Tez_repr.(old_amount +? amount)
  >>=? fun new_amount ->
  Storage.Contract.Frozen_rewards.init_set (ctxt, contract) cycle new_amount
  >>= fun ctxt ->
  Storage.Delegates_with_frozen_balance.add (ctxt, cycle) delegate
  >>= fun ctxt -> return ctxt

let freeze_rewards ctxt delegate amount =
  let {Level_repr.cycle; _} = Level_storage.current ctxt in
  credit_frozen_rewards ctxt delegate cycle amount

let burn_rewards ctxt delegate cycle amount =
  let contract = Contract_repr.implicit_contract delegate in
  get_frozen_rewards ctxt contract cycle
  >>=? fun old_amount ->
  let new_amount =
    match Tez_repr.(old_amount -? amount) with
    | Error _ ->
        Tez_repr.zero
    | Ok new_amount ->
        new_amount
  in
  Storage.Contract.Frozen_rewards.init_set (ctxt, contract) cycle new_amount
  >>= fun ctxt -> return ctxt

let unfreeze ctxt delegate cycle =
  let contract = Contract_repr.implicit_contract delegate in
  get_frozen_deposit ctxt contract cycle
  >>=? fun deposit ->
  get_frozen_fees ctxt contract cycle
  >>=? fun fees ->
  get_frozen_rewards ctxt contract cycle
  >>=? fun rewards ->
  Storage.Contract.Balance.get ctxt contract
  >>=? fun balance ->
  Lwt.return Tez_repr.(deposit +? fees)
  >>=? fun unfrozen_amount ->
  Lwt.return Tez_repr.(unfrozen_amount +? rewards)
  >>=? fun unfrozen_amount ->
  Lwt.return Tez_repr.(balance +? unfrozen_amount)
  >>=? fun balance ->
  Storage.Contract.Balance.set ctxt contract balance
  >>=? fun ctxt ->
  Roll_storage.Delegate.add_amount ctxt delegate rewards
  >>=? fun ctxt ->
  Storage.Contract.Frozen_deposits.remove (ctxt, contract) cycle
  >>= fun ctxt ->
  Storage.Contract.Frozen_fees.remove (ctxt, contract) cycle
  >>= fun ctxt ->
  Storage.Contract.Frozen_rewards.remove (ctxt, contract) cycle
  >>= fun ctxt ->
  return
    ( ctxt,
      cleanup_balance_updates
        [ (Deposits (delegate, cycle), Debited deposit);
          (Fees (delegate, cycle), Debited fees);
          (Rewards (delegate, cycle), Debited rewards);
          ( Contract (Contract_repr.implicit_contract delegate),
            Credited unfrozen_amount ) ] )

let cycle_end ctxt last_cycle unrevealed =
  let preserved = Constants_storage.preserved_cycles ctxt in
  ( match Cycle_repr.pred last_cycle with
  | None ->
      return (ctxt, [])
  | Some revealed_cycle ->
      List.fold_left
        (fun acc (u : Nonce_storage.unrevealed) ->
          acc
          >>=? fun (ctxt, balance_updates) ->
          burn_fees ctxt u.delegate revealed_cycle u.fees
          >>=? fun ctxt ->
          burn_rewards ctxt u.delegate revealed_cycle u.rewards
          >>=? fun ctxt ->
          let bus =
            [ (Fees (u.delegate, revealed_cycle), Debited u.fees);
              (Rewards (u.delegate, revealed_cycle), Debited u.rewards) ]
          in
          return (ctxt, bus @ balance_updates))
        (return (ctxt, []))
        unrevealed )
  >>=? fun (ctxt, balance_updates) ->
  match Cycle_repr.sub last_cycle preserved with
  | None ->
      return (ctxt, balance_updates, [])
  | Some unfrozen_cycle ->
      Storage.Delegates_with_frozen_balance.fold
        (ctxt, unfrozen_cycle)
        ~init:(Ok (ctxt, balance_updates))
        ~f:(fun delegate acc ->
          Lwt.return acc
          >>=? fun (ctxt, bus) ->
          unfreeze ctxt delegate unfrozen_cycle
          >>=? fun (ctxt, balance_updates) ->
          return (ctxt, balance_updates @ bus))
      >>=? fun (ctxt, balance_updates) ->
      Storage.Delegates_with_frozen_balance.clear (ctxt, unfrozen_cycle)
      >>= fun ctxt ->
      Storage.Active_delegates_with_rolls.fold
        ctxt
        ~init:(Ok (ctxt, []))
        ~f:(fun delegate acc ->
          Lwt.return acc
          >>=? fun (ctxt, deactivated) ->
          Storage.Contract.Delegate_desactivation.get
            ctxt
            (Contract_repr.implicit_contract delegate)
          >>=? fun cycle ->
          if Cycle_repr.(cycle <= last_cycle) then
            Roll_storage.Delegate.set_inactive ctxt delegate
            >>=? fun ctxt -> return (ctxt, delegate :: deactivated)
          else return (ctxt, deactivated))
      >>=? fun (ctxt, deactivated) ->
      return (ctxt, balance_updates, deactivated)

let punish ctxt delegate cycle =
  let contract = Contract_repr.implicit_contract delegate in
  get_frozen_deposit ctxt contract cycle
  >>=? fun deposit ->
  get_frozen_fees ctxt contract cycle
  >>=? fun fees ->
  get_frozen_rewards ctxt contract cycle
  >>=? fun rewards ->
  Roll_storage.Delegate.remove_amount ctxt delegate deposit
  >>=? fun ctxt ->
  Roll_storage.Delegate.remove_amount ctxt delegate fees
  >>=? fun ctxt ->
  (* Rewards are not accounted in the delegate's rolls yet... *)
  Storage.Contract.Frozen_deposits.remove (ctxt, contract) cycle
  >>= fun ctxt ->
  Storage.Contract.Frozen_fees.remove (ctxt, contract) cycle
  >>= fun ctxt ->
  Storage.Contract.Frozen_rewards.remove (ctxt, contract) cycle
  >>= fun ctxt -> return (ctxt, {deposit; fees; rewards})

let has_frozen_balance ctxt delegate cycle =
  let contract = Contract_repr.implicit_contract delegate in
  get_frozen_deposit ctxt contract cycle
  >>=? fun deposit ->
  if Tez_repr.(deposit <> zero) then return_true
  else
    get_frozen_fees ctxt contract cycle
    >>=? fun fees ->
    if Tez_repr.(fees <> zero) then return_true
    else
      get_frozen_rewards ctxt contract cycle
      >>=? fun rewards -> return Tez_repr.(rewards <> zero)

let frozen_balance_by_cycle_encoding =
  let open Data_encoding in
  conv
    Cycle_repr.Map.bindings
    (List.fold_left
       (fun m (c, b) -> Cycle_repr.Map.add c b m)
       Cycle_repr.Map.empty)
    (list
       (merge_objs
          (obj1 (req "cycle" Cycle_repr.encoding))
          frozen_balance_encoding))

let empty_frozen_balance =
  {deposit = Tez_repr.zero; fees = Tez_repr.zero; rewards = Tez_repr.zero}

let frozen_balance_by_cycle ctxt delegate =
  let contract = Contract_repr.implicit_contract delegate in
  let map = Cycle_repr.Map.empty in
  Storage.Contract.Frozen_deposits.fold
    (ctxt, contract)
    ~init:map
    ~f:(fun cycle amount map ->
      Lwt.return
        (Cycle_repr.Map.add
           cycle
           {empty_frozen_balance with deposit = amount}
           map))
  >>= fun map ->
  Storage.Contract.Frozen_fees.fold
    (ctxt, contract)
    ~init:map
    ~f:(fun cycle amount map ->
      let balance =
        match Cycle_repr.Map.find_opt cycle map with
        | None ->
            empty_frozen_balance
        | Some balance ->
            balance
      in
      Lwt.return (Cycle_repr.Map.add cycle {balance with fees = amount} map))
  >>= fun map ->
  Storage.Contract.Frozen_rewards.fold
    (ctxt, contract)
    ~init:map
    ~f:(fun cycle amount map ->
      let balance =
        match Cycle_repr.Map.find_opt cycle map with
        | None ->
            empty_frozen_balance
        | Some balance ->
            balance
      in
      Lwt.return (Cycle_repr.Map.add cycle {balance with rewards = amount} map))
  >>= fun map -> Lwt.return map

let frozen_balance ctxt delegate =
  let contract = Contract_repr.implicit_contract delegate in
  let balance = Ok Tez_repr.zero in
  Storage.Contract.Frozen_deposits.fold
    (ctxt, contract)
    ~init:balance
    ~f:(fun _cycle amount acc ->
      Lwt.return acc >>=? fun acc -> Lwt.return Tez_repr.(acc +? amount))
  >>= fun balance ->
  Storage.Contract.Frozen_fees.fold
    (ctxt, contract)
    ~init:balance
    ~f:(fun _cycle amount acc ->
      Lwt.return acc >>=? fun acc -> Lwt.return Tez_repr.(acc +? amount))
  >>= fun balance ->
  Storage.Contract.Frozen_rewards.fold
    (ctxt, contract)
    ~init:balance
    ~f:(fun _cycle amount acc ->
      Lwt.return acc >>=? fun acc -> Lwt.return Tez_repr.(acc +? amount))
  >>= fun balance -> Lwt.return balance

let full_balance ctxt delegate =
  let contract = Contract_repr.implicit_contract delegate in
  frozen_balance ctxt delegate
  >>=? fun frozen_balance ->
  Storage.Contract.Balance.get ctxt contract
  >>=? fun balance -> Lwt.return Tez_repr.(frozen_balance +? balance)

let deactivated = Roll_storage.Delegate.is_inactive

let grace_period ctxt delegate =
  let contract = Contract_repr.implicit_contract delegate in
  Storage.Contract.Delegate_desactivation.get ctxt contract

let staking_balance ctxt delegate =
  let token_per_rolls = Constants_storage.tokens_per_roll ctxt in
  Roll_storage.get_rolls ctxt delegate
  >>=? fun rolls ->
  Roll_storage.get_change ctxt delegate
  >>=? fun change ->
  let rolls = Int64.of_int (List.length rolls) in
  Lwt.return Tez_repr.(token_per_rolls *? rolls)
  >>=? fun balance -> Lwt.return Tez_repr.(balance +? change)

let delegated_balance ctxt delegate =
  let contract = Contract_repr.implicit_contract delegate in
  staking_balance ctxt delegate
  >>=? fun staking_balance ->
  Storage.Contract.Balance.get ctxt contract
  >>= fun self_staking_balance ->
  Storage.Contract.Frozen_deposits.fold
    (ctxt, contract)
    ~init:self_staking_balance
    ~f:(fun _cycle amount acc ->
      Lwt.return acc >>=? fun acc -> Lwt.return Tez_repr.(acc +? amount))
  >>= fun self_staking_balance ->
  Storage.Contract.Frozen_fees.fold
    (ctxt, contract)
    ~init:self_staking_balance
    ~f:(fun _cycle amount acc ->
      Lwt.return acc >>=? fun acc -> Lwt.return Tez_repr.(acc +? amount))
  >>=? fun self_staking_balance ->
  Lwt.return Tez_repr.(staking_balance -? self_staking_balance)

let fold = Storage.Delegates.fold

let list = Storage.Delegates.elements

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Inductive balance : Set :=
| Contract : Tezos_raw_protocol_alpha.Contract_repr.t -> balance
| Rewards :
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Tezos_raw_protocol_alpha.Cycle_repr.t -> balance
| Fees :
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Tezos_raw_protocol_alpha.Cycle_repr.t -> balance
| Deposits :
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Tezos_raw_protocol_alpha.Cycle_repr.t -> balance.

Definition balance_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding balance :=
  op_atat
    (let arg := def "operation_metadata.alpha.balance" % string in
    fun eta => arg None None eta)
    (union None
      (cons
        (__case_value "Contract" % string None
          (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag 0)
          (obj2 (req None None "kind" % string (constant "contract" % string))
            (req None None "contract" % string Contract_repr.encoding))
          (fun function_parameter =>
            match function_parameter with
            | Contract c => Some (tt, c)
            | _ => None
            end)
          (fun function_parameter =>
            let '(tt, c) := function_parameter in
            Contract c))
        (cons
          (__case_value "Rewards" % string None
            (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag 1)
            (obj4 (req None None "kind" % string (constant "freezer" % string))
              (req None None "category" % string (constant "rewards" % string))
              (req None None "delegate" % string
                Signature.Public_key_hash.encoding)
              (req None None "cycle" % string Cycle_repr.encoding))
            (fun function_parameter =>
              match function_parameter with
              | Rewards d l => Some (tt, tt, d, l)
              | _ => None
              end)
            (fun function_parameter =>
              let '(tt, tt, d, l) := function_parameter in
              Rewards d l))
          (cons
            (__case_value "Fees" % string None
              (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag 2)
              (obj4
                (req None None "kind" % string (constant "freezer" % string))
                (req None None "category" % string (constant "fees" % string))
                (req None None "delegate" % string
                  Signature.Public_key_hash.encoding)
                (req None None "cycle" % string Cycle_repr.encoding))
              (fun function_parameter =>
                match function_parameter with
                | Fees d l => Some (tt, tt, d, l)
                | _ => None
                end)
              (fun function_parameter =>
                let '(tt, tt, d, l) := function_parameter in
                Fees d l))
            (cons
              (__case_value "Deposits" % string None
                (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag
                  3)
                (obj4
                  (req None None "kind" % string (constant "freezer" % string))
                  (req None None "category" % string
                    (constant "deposits" % string))
                  (req None None "delegate" % string
                    Signature.Public_key_hash.encoding)
                  (req None None "cycle" % string Cycle_repr.encoding))
                (fun function_parameter =>
                  match function_parameter with
                  | Deposits d l => Some (tt, tt, d, l)
                  | _ => None
                  end)
                (fun function_parameter =>
                  let '(tt, tt, d, l) := function_parameter in
                  Deposits d l)) []))))).

Inductive balance_update : Set :=
| Debited : Tezos_raw_protocol_alpha.Tez_repr.t -> balance_update
| Credited : Tezos_raw_protocol_alpha.Tez_repr.t -> balance_update.

Definition balance_update_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    balance_update :=
  op_atat
    (let arg := def "operation_metadata.alpha.balance_update" % string in
    fun eta => arg None None eta)
    (obj1
      (req None None "change" % string
        (conv
          (fun function_parameter =>
            match function_parameter with
            | Credited v => Tez_repr.to_mutez v
            | Debited v => Int64.neg (Tez_repr.to_mutez v)
            end)
          (op_atat Json.wrap_error
            (fun v =>
              if
                op_lt v
                  (* ❌ Constant of type int64 is converted to int *)
                  0 then
                match Tez_repr.of_mutez (Int64.neg v) with
                | Some v => Debited v
                | None => failwith "Qty.of_mutez" % string
                end
              else
                match Tez_repr.of_mutez v with
                | Some v => Credited v
                | None => failwith "Qty.of_mutez" % string
                end)) None __int64_value))).

Definition balance_updates := list (balance * balance_update).

Definition balance_updates_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    (list (balance * balance_update)) :=
  op_atat
    (let arg := def "operation_metadata.alpha.balance_updates" % string in
    fun eta => arg None None eta)
    (__list_value None (merge_objs balance_encoding balance_update_encoding)).

Definition cleanup_balance_updates {A : Set}
  (balance_updates : list (A * balance_update)) : list (A * balance_update) :=
  List.filter
    (fun function_parameter =>
      let '(_, Credited update | Debited update) := function_parameter in
      not (Tez_repr.equal update Tez_repr.zero)) balance_updates.

Module frozen_balance.
  Record record := {
    deposit : Tezos_raw_protocol_alpha.Tez_repr.t;
    fees : Tezos_raw_protocol_alpha.Tez_repr.t;
    rewards : Tezos_raw_protocol_alpha.Tez_repr.t }.
End frozen_balance.
Definition frozen_balance := frozen_balance.record.

Definition frozen_balance_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    frozen_balance :=
  conv
    (fun function_parameter =>
      let '{|
        frozen_balance.deposit := deposit;
          frozen_balance.fees := fees;
          frozen_balance.rewards := rewards
          |} := function_parameter in
      (deposit, fees, rewards))
    (fun function_parameter =>
      let '(deposit, fees, rewards) := function_parameter in
      {| frozen_balance.deposit := deposit; frozen_balance.fees := fees;
        frozen_balance.rewards := rewards |}) None
    (obj3 (req None None "deposit" % string Tez_repr.encoding)
      (req None None "fees" % string Tez_repr.encoding)
      (req None None "rewards" % string Tez_repr.encoding)).

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Top-level evaluations are considered as an error as sources of side-effects *)
Compute
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "delegate.no_deletion" % string
      "Forbidden delegate deletion" % string
      "Tried to unregister a delegate" % string
      (Some
        (fun ppf =>
          fun delegate =>
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Delegate deletion is forbidden (" % string
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Char_literal
                      ")" % char
                      Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))
                "Delegate deletion is forbidden (%a)" % string)
              Signature.Public_key_hash.pp delegate))
      (obj1
        (req None None "delegate" % string Signature.Public_key_hash.encoding))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.No_deletion
            c => Some c
        | _ => None
        end)
      (fun c =>
        Tezos_protocol_environment_alpha__Environment.Error_monad.No_deletion c)
    in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "delegate.already_active" % string
      "Delegate already active" % string
      "Useless delegate reactivation" % string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let 'tt := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "The delegate is still active, no need to refresh it" % string
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
                "The delegate is still active, no need to refresh it" % string)))
      Data_encoding.empty
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Active_delegate
          => Some tt
        | _ => None
        end)
      (fun function_parameter =>
        let 'tt := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Active_delegate)
    in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "delegate.unchanged" % string "Unchanged delegated" % string
      "Contract already delegated to the given delegate" % string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let 'tt := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "The contract is already delegated to the same delegate" %
                    string
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
                "The contract is already delegated to the same delegate" %
                  string))) Data_encoding.empty
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Current_delegate
          => Some tt
        | _ => None
        end)
      (fun function_parameter =>
        let 'tt := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Current_delegate)
    in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "delegate.empty_delegate_account" % string
      "Empty delegate account" % string
      "Cannot register a delegate when its implicit account is empty" % string
      (Some
        (fun ppf =>
          fun delegate =>
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Delegate registration is forbidden when the delegate
           implicit account is empty ("
                    % string
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Char_literal
                      ")" % char
                      Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))
                "Delegate registration is forbidden when the delegate
           implicit account is empty (%a)"
                  % string) Signature.Public_key_hash.pp delegate))
      (obj1
        (req None None "delegate" % string Signature.Public_key_hash.encoding))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Empty_delegate_account
            c => Some c
        | _ => None
        end)
      (fun c =>
        Tezos_protocol_environment_alpha__Environment.Error_monad.Empty_delegate_account
          c) in
  register_error_kind
    (* ❌ Variants not supported *)
    variant "delegate.balance_too_low_for_deposit" % string
    "Balance too low for deposit" % string
    "Cannot freeze deposit when the balance is too low" % string
    (Some
      (fun ppf =>
        fun function_parameter =>
          let '(delegate, balance, deposit) := function_parameter in
          Format.fprintf ppf
            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                "Delegate " % string
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                    " has a too low balance (" % string
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                        ") to deposit " % string
                        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                          Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format))))))
              "Delegate %a has a too low balance (%a) to deposit %a" % string)
            Signature.Public_key_hash.pp delegate Tez_repr.pp balance
            Tez_repr.pp deposit))
    (obj3 (req None None "delegate" % string Signature.Public_key_hash.encoding)
      (req None None "balance" % string Tez_repr.encoding)
      (req None None "deposit" % string Tez_repr.encoding))
    (fun function_parameter =>
      match function_parameter with
      |
        Tezos_protocol_environment_alpha__Environment.Error_monad.Balance_too_low_for_deposit
          {|
          Balance_too_low_for_deposit.delegate := delegate;
            Balance_too_low_for_deposit.deposit := deposit;
            Balance_too_low_for_deposit.balance := balance
            |} => Some (delegate, balance, deposit)
      | _ => None
      end)
    (fun function_parameter =>
      let '(delegate, balance, deposit) := function_parameter in
      Tezos_protocol_environment_alpha__Environment.Error_monad.Balance_too_low_for_deposit
        {| Balance_too_low_for_deposit.delegate := delegate;
          Balance_too_low_for_deposit.deposit := deposit;
          Balance_too_low_for_deposit.balance := balance |}).

Definition link
  (c : Tezos_raw_protocol_alpha.Storage.Contract.Balance.context)
  (contract : Tezos_raw_protocol_alpha.Storage.Contract.Balance.key)
  (delegate :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  op_gtgteqquestion (Storage.Contract.Balance.get c contract)
    (fun balance =>
      op_gtgteqquestion (Roll_storage.Delegate.add_amount c delegate balance)
        (fun c =>
          op_gtgteq
            (Storage.Contract.Delegated.add
              (c, (Contract_repr.implicit_contract delegate)) contract)
            (fun c => __return c))).

Definition unlink
  (c : Tezos_raw_protocol_alpha.Storage.Contract.Balance.context)
  (contract : Tezos_raw_protocol_alpha.Storage.Contract.Balance.key)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Storage.Contract.Balance.context) :=
  op_gtgteqquestion (Storage.Contract.Balance.get c contract)
    (fun balance =>
      op_gtgteqquestion (Storage.Contract.Delegate.get_option c contract)
        (fun function_parameter =>
          match function_parameter with
          | None => __return c
          | Some delegate =>
            op_gtgteqquestion
              (Roll_storage.Delegate.remove_amount c delegate balance)
              (fun c =>
                op_gtgteq
                  (Storage.Contract.Delegated.del
                    (c, (Contract_repr.implicit_contract delegate)) contract)
                  (fun c => __return c))
          end)).

Definition known
  (c : Tezos_raw_protocol_alpha.Storage.Contract.Manager.context)
  (delegate :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult bool) :=
  op_gtgteqquestion
    (Storage.Contract.Manager.get_option c
      (Contract_repr.implicit_contract delegate))
    (fun function_parameter =>
      match function_parameter with
      | None | Some (Tezos_raw_protocol_alpha.Manager_repr.Hash _) =>
        return_false
      | Some (Tezos_raw_protocol_alpha.Manager_repr.Public_key _) => return_true
      end).

Definition registered
  (c : Tezos_raw_protocol_alpha.Storage.Contract.Delegate.context)
  (delegate :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult bool) :=
  op_gtgteqquestion
    (Storage.Contract.Delegate.get_option c
      (Contract_repr.implicit_contract delegate))
    (fun function_parameter =>
      match function_parameter with
      | Some current_delegate =>
        op_atat __return
          (Signature.Public_key_hash.equal delegate current_delegate)
      | None => return_false
      end).

Definition init
  (ctxt : Tezos_raw_protocol_alpha.Storage.Contract.Manager.context)
  (contract : Tezos_raw_protocol_alpha.Storage.Contract.Delegate.key)
  (delegate :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  op_gtgteqquestion (known ctxt delegate)
    (fun known_delegate =>
      op_gtgteqquestion
        (fail_unless known_delegate
          (Tezos_protocol_environment_alpha__Environment.Error_monad.Unregistered_delegate
            delegate))
        (fun function_parameter =>
          let 'tt := function_parameter in
          op_gtgteqquestion (registered ctxt delegate)
            (fun is_registered =>
              op_gtgteqquestion
                (fail_unless is_registered
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.Unregistered_delegate
                    delegate))
                (fun function_parameter =>
                  let 'tt := function_parameter in
                  op_gtgteqquestion
                    (Storage.Contract.Delegate.init ctxt contract delegate)
                    (fun ctxt => link ctxt contract delegate))))).

Definition get
  : Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Contract_repr.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (option
        Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)) :=
  Roll_storage.get_contract_delegate.

Definition set
  (c : Tezos_raw_protocol_alpha.Storage.Contract.Balance.context)
  (contract : Tezos_raw_protocol_alpha.Storage.Contract.Balance.key)
  (delegate :
    option
      Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  match delegate with
  | None =>
    let delete (function_parameter : unit)
      : Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t) :=
      let 'tt := function_parameter in
      op_gtgteqquestion (unlink c contract)
        (fun c =>
          op_gtgteq (Storage.Contract.Delegate.remove c contract)
            (fun c => __return c)) in
    match Contract_repr.is_implicit contract with
    | Some pkh =>
      op_gtgteqquestion (registered c pkh)
        (fun is_registered =>
          if is_registered then
            fail
              (Tezos_protocol_environment_alpha__Environment.Error_monad.No_deletion
                pkh)
          else
            delete tt)
    | None => delete tt
    end
  | Some delegate =>
    op_gtgteqquestion (known c delegate)
      (fun known_delegate =>
        op_gtgteqquestion (registered c delegate)
          (fun registered_delegate =>
            let self_delegation :=
              match Contract_repr.is_implicit contract with
              | Some pkh => Signature.Public_key_hash.equal pkh delegate
              | None => false
              end in
            if
              op_pipepipe (not known_delegate)
                (not (op_pipepipe registered_delegate self_delegation)) then
              fail
                (Tezos_protocol_environment_alpha__Environment.Error_monad.Unregistered_delegate
                  delegate)
            else
              op_gtgteqquestion
                (op_gtgteqquestion
                  (Storage.Contract.Delegate.get_option c contract)
                  (fun function_parameter =>
                    match function_parameter with
                    | Some current_delegate =>
                      if self_delegation then
                        op_gtgteqquestion
                          (Roll_storage.Delegate.is_inactive c delegate)
                          (fun function_parameter =>
                            match function_parameter with
                            | true => return_unit
                            | false =>
                              fail
                                Tezos_protocol_environment_alpha__Environment.Error_monad.Active_delegate
                            end)
                      else
                        fail
                          Tezos_protocol_environment_alpha__Environment.Error_monad.Current_delegate
                    | None | Some _ => return_unit
                    end))
                (fun function_parameter =>
                  let 'tt := function_parameter in
                  op_gtgteqquestion
                    match Contract_repr.is_implicit contract with
                    | Some pkh =>
                      op_gtgteqquestion (registered c pkh)
                        (fun is_registered =>
                          if op_andand (not self_delegation) is_registered then
                            fail
                              (Tezos_protocol_environment_alpha__Environment.Error_monad.No_deletion
                                pkh)
                          else
                            return_unit)
                    | None => return_unit
                    end
                    (fun function_parameter =>
                      let 'tt := function_parameter in
                      op_gtgteq (Storage.Contract.Balance.mem c contract)
                        (fun __exists =>
                          op_gtgteqquestion
                            (fail_when
                              (op_andand self_delegation (not __exists))
                              (Tezos_protocol_environment_alpha__Environment.Error_monad.Empty_delegate_account
                                delegate))
                            (fun function_parameter =>
                              let 'tt := function_parameter in
                              op_gtgteqquestion (unlink c contract)
                                (fun c =>
                                  op_gtgteq
                                    (Storage.Contract.Delegate.init_set c
                                      contract delegate)
                                    (fun c =>
                                      op_gtgteqquestion
                                        (link c contract delegate)
                                        (fun c =>
                                          op_gtgteqquestion
                                            (if self_delegation then
                                              op_gtgteq
                                                (Storage.Delegates.add c
                                                  delegate)
                                                (fun c =>
                                                  op_gtgteqquestion
                                                    (Roll_storage.Delegate.set_active
                                                      c delegate)
                                                    (fun c => __return c))
                                            else
                                              __return c) (fun c => __return c))))))))))
  end.

Definition remove
  (ctxt : Tezos_raw_protocol_alpha.Storage.Contract.Balance.context)
  (contract : Tezos_raw_protocol_alpha.Storage.Contract.Balance.key)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Storage.Contract.Balance.context) :=
  unlink ctxt contract.

Definition delegated_contracts
  (ctxt : Tezos_raw_protocol_alpha.Raw_context.t)
  (delegate :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (list Tezos_raw_protocol_alpha.Storage.Contract.Delegated.elt) :=
  let contract := Contract_repr.implicit_contract delegate in
  Storage.Contract.Delegated.elements (ctxt, contract).

Definition get_frozen_deposit
  (ctxt : Tezos_raw_protocol_alpha.Raw_context.t)
  (contract : Tezos_raw_protocol_alpha.Contract_repr.t)
  (cycle : Tezos_raw_protocol_alpha.Storage.Contract.Frozen_deposits.key)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Tez_repr.t) :=
  op_gtgteqquestion
    (Storage.Contract.Frozen_deposits.get_option (ctxt, contract) cycle)
    (fun function_parameter =>
      match function_parameter with
      | None => __return Tez_repr.zero
      | Some frozen => __return frozen
      end).

Definition credit_frozen_deposit
  (ctxt : Tezos_raw_protocol_alpha.Raw_context.t)
  (delegate :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  (cycle : Tezos_raw_protocol_alpha.Storage.Contract.Frozen_deposits.key)
  (amount : Tezos_raw_protocol_alpha.Tez_repr.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  let contract := Contract_repr.implicit_contract delegate in
  op_gtgteqquestion (get_frozen_deposit ctxt contract cycle)
    (fun old_amount =>
      op_gtgteqquestion (Lwt.__return (op_plusquestion old_amount amount))
        (fun new_amount =>
          op_gtgteq
            (Storage.Contract.Frozen_deposits.init_set (ctxt, contract) cycle
              new_amount)
            (fun ctxt =>
              op_gtgteq
                (Storage.Delegates_with_frozen_balance.add (ctxt, cycle)
                  delegate) (fun ctxt => __return ctxt)))).

Definition freeze_deposit
  (ctxt : Tezos_raw_protocol_alpha.Raw_context.t)
  (delegate :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  (amount : Tezos_raw_protocol_alpha.Tez_repr.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  let '{| Tezos_raw_protocol_alpha.Level_repr.t.cycle := cycle |} :=
    Level_storage.current ctxt in
  op_gtgteqquestion (Roll_storage.Delegate.set_active ctxt delegate)
    (fun ctxt =>
      let contract := Contract_repr.implicit_contract delegate in
      op_gtgteqquestion (Storage.Contract.Balance.get ctxt contract)
        (fun balance =>
          op_gtgteqquestion
            (Lwt.__return
              (record_trace
                (Tezos_protocol_environment_alpha__Environment.Error_monad.Balance_too_low_for_deposit
                  {| Balance_too_low_for_deposit.delegate := delegate;
                    Balance_too_low_for_deposit.deposit := amount;
                    Balance_too_low_for_deposit.balance := balance |})
                (op_minusquestion balance amount)))
            (fun new_balance =>
              op_gtgteqquestion
                (Storage.Contract.Balance.set ctxt contract new_balance)
                (fun ctxt => credit_frozen_deposit ctxt delegate cycle amount)))).

Definition get_frozen_fees
  (ctxt : Tezos_raw_protocol_alpha.Raw_context.t)
  (contract : Tezos_raw_protocol_alpha.Contract_repr.t)
  (cycle : Tezos_raw_protocol_alpha.Storage.Contract.Frozen_fees.key)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Tez_repr.t) :=
  op_gtgteqquestion
    (Storage.Contract.Frozen_fees.get_option (ctxt, contract) cycle)
    (fun function_parameter =>
      match function_parameter with
      | None => __return Tez_repr.zero
      | Some frozen => __return frozen
      end).

Definition credit_frozen_fees
  (ctxt : Tezos_raw_protocol_alpha.Raw_context.t)
  (delegate :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  (cycle : Tezos_raw_protocol_alpha.Storage.Contract.Frozen_fees.key)
  (amount : Tezos_raw_protocol_alpha.Tez_repr.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  let contract := Contract_repr.implicit_contract delegate in
  op_gtgteqquestion (get_frozen_fees ctxt contract cycle)
    (fun old_amount =>
      op_gtgteqquestion (Lwt.__return (op_plusquestion old_amount amount))
        (fun new_amount =>
          op_gtgteq
            (Storage.Contract.Frozen_fees.init_set (ctxt, contract) cycle
              new_amount)
            (fun ctxt =>
              op_gtgteq
                (Storage.Delegates_with_frozen_balance.add (ctxt, cycle)
                  delegate) (fun ctxt => __return ctxt)))).

Definition freeze_fees
  (ctxt : Tezos_raw_protocol_alpha.Raw_context.t)
  (delegate :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  (amount : Tezos_raw_protocol_alpha.Tez_repr.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  let '{| Tezos_raw_protocol_alpha.Level_repr.t.cycle := cycle |} :=
    Level_storage.current ctxt in
  op_gtgteqquestion (Roll_storage.Delegate.add_amount ctxt delegate amount)
    (fun ctxt => credit_frozen_fees ctxt delegate cycle amount).

Definition burn_fees
  (ctxt : Tezos_raw_protocol_alpha.Raw_context.t)
  (delegate :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  (cycle : Tezos_raw_protocol_alpha.Storage.Contract.Frozen_fees.key)
  (amount : Tezos_raw_protocol_alpha.Tez_repr.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  let contract := Contract_repr.implicit_contract delegate in
  op_gtgteqquestion (get_frozen_fees ctxt contract cycle)
    (fun old_amount =>
      op_gtgteqquestion
        match op_minusquestion old_amount amount with
        | Tezos_protocol_environment_alpha__Environment.Pervasives.Ok new_amount
          =>
          op_gtgteqquestion
            (Roll_storage.Delegate.remove_amount ctxt delegate amount)
            (fun ctxt => __return (new_amount, ctxt))
        | Tezos_protocol_environment_alpha__Environment.Pervasives.Error _ =>
          op_gtgteqquestion
            (Roll_storage.Delegate.remove_amount ctxt delegate old_amount)
            (fun ctxt => __return (Tez_repr.zero, ctxt))
        end
        (fun function_parameter =>
          let '(new_amount, ctxt) := function_parameter in
          op_gtgteq
            (Storage.Contract.Frozen_fees.init_set (ctxt, contract) cycle
              new_amount) (fun ctxt => __return ctxt))).

Definition get_frozen_rewards
  (ctxt : Tezos_raw_protocol_alpha.Raw_context.t)
  (contract : Tezos_raw_protocol_alpha.Contract_repr.t)
  (cycle : Tezos_raw_protocol_alpha.Storage.Contract.Frozen_rewards.key)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Tez_repr.t) :=
  op_gtgteqquestion
    (Storage.Contract.Frozen_rewards.get_option (ctxt, contract) cycle)
    (fun function_parameter =>
      match function_parameter with
      | None => __return Tez_repr.zero
      | Some frozen => __return frozen
      end).

Definition credit_frozen_rewards
  (ctxt : Tezos_raw_protocol_alpha.Raw_context.t)
  (delegate :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  (cycle : Tezos_raw_protocol_alpha.Storage.Contract.Frozen_rewards.key)
  (amount : Tezos_raw_protocol_alpha.Tez_repr.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  let contract := Contract_repr.implicit_contract delegate in
  op_gtgteqquestion (get_frozen_rewards ctxt contract cycle)
    (fun old_amount =>
      op_gtgteqquestion (Lwt.__return (op_plusquestion old_amount amount))
        (fun new_amount =>
          op_gtgteq
            (Storage.Contract.Frozen_rewards.init_set (ctxt, contract) cycle
              new_amount)
            (fun ctxt =>
              op_gtgteq
                (Storage.Delegates_with_frozen_balance.add (ctxt, cycle)
                  delegate) (fun ctxt => __return ctxt)))).

Definition freeze_rewards
  (ctxt : Tezos_raw_protocol_alpha.Raw_context.t)
  (delegate :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  (amount : Tezos_raw_protocol_alpha.Tez_repr.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  let '{| Tezos_raw_protocol_alpha.Level_repr.t.cycle := cycle |} :=
    Level_storage.current ctxt in
  credit_frozen_rewards ctxt delegate cycle amount.

Definition burn_rewards
  (ctxt : Tezos_raw_protocol_alpha.Raw_context.t)
  (delegate :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  (cycle : Tezos_raw_protocol_alpha.Storage.Contract.Frozen_rewards.key)
  (amount : Tezos_raw_protocol_alpha.Tez_repr.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  let contract := Contract_repr.implicit_contract delegate in
  op_gtgteqquestion (get_frozen_rewards ctxt contract cycle)
    (fun old_amount =>
      let new_amount :=
        match op_minusquestion old_amount amount with
        | Tezos_protocol_environment_alpha__Environment.Pervasives.Error _ =>
          Tez_repr.zero
        | Tezos_protocol_environment_alpha__Environment.Pervasives.Ok new_amount
          => new_amount
        end in
      op_gtgteq
        (Storage.Contract.Frozen_rewards.init_set (ctxt, contract) cycle
          new_amount) (fun ctxt => __return ctxt)).

Definition unfreeze
  (ctxt : Tezos_raw_protocol_alpha.Raw_context.t)
  (delegate :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  (cycle : Tezos_raw_protocol_alpha.Storage.Contract.Frozen_deposits.key)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Raw_context.t * list (balance * balance_update))) :=
  let contract := Contract_repr.implicit_contract delegate in
  op_gtgteqquestion (get_frozen_deposit ctxt contract cycle)
    (fun deposit =>
      op_gtgteqquestion (get_frozen_fees ctxt contract cycle)
        (fun fees =>
          op_gtgteqquestion (get_frozen_rewards ctxt contract cycle)
            (fun rewards =>
              op_gtgteqquestion (Storage.Contract.Balance.get ctxt contract)
                (fun balance =>
                  op_gtgteqquestion
                    (Lwt.__return (op_plusquestion deposit fees))
                    (fun unfrozen_amount =>
                      op_gtgteqquestion
                        (Lwt.__return (op_plusquestion unfrozen_amount rewards))
                        (fun unfrozen_amount =>
                          op_gtgteqquestion
                            (Lwt.__return
                              (op_plusquestion balance unfrozen_amount))
                            (fun balance =>
                              op_gtgteqquestion
                                (Storage.Contract.Balance.set ctxt contract
                                  balance)
                                (fun ctxt =>
                                  op_gtgteqquestion
                                    (Roll_storage.Delegate.add_amount ctxt
                                      delegate rewards)
                                    (fun ctxt =>
                                      op_gtgteq
                                        (Storage.Contract.Frozen_deposits.remove
                                          (ctxt, contract) cycle)
                                        (fun ctxt =>
                                          op_gtgteq
                                            (Storage.Contract.Frozen_fees.remove
                                              (ctxt, contract) cycle)
                                            (fun ctxt =>
                                              op_gtgteq
                                                (Storage.Contract.Frozen_rewards.remove
                                                  (ctxt, contract) cycle)
                                                (fun ctxt =>
                                                  __return
                                                    (ctxt,
                                                      (cleanup_balance_updates
                                                        (cons
                                                          ((Deposits delegate
                                                            cycle),
                                                            (Debited deposit))
                                                          (cons
                                                            ((Fees delegate
                                                              cycle),
                                                              (Debited fees))
                                                            (cons
                                                              ((Rewards delegate
                                                                cycle),
                                                                (Debited rewards))
                                                              (cons
                                                                ((Contract
                                                                  (Contract_repr.implicit_contract
                                                                    delegate)),
                                                                  (Credited
                                                                    unfrozen_amount))
                                                                [])))))))))))))))))).

Definition cycle_end
  (ctxt : Tezos_raw_protocol_alpha.Raw_context.context)
  (last_cycle : Tezos_raw_protocol_alpha.Cycle_repr.cycle)
  (unrevealed : list Tezos_raw_protocol_alpha.Nonce_storage.unrevealed)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Raw_context.context *
        list (balance * balance_update) *
        list Tezos_raw_protocol_alpha.Storage.Active_delegates_with_rolls.elt)) :=
  let preserved := Constants_storage.preserved_cycles ctxt in
  op_gtgteqquestion
    match Cycle_repr.pred last_cycle with
    | None => __return (ctxt, [])
    | Some revealed_cycle =>
      List.fold_left
        (fun acc =>
          fun u =>
            op_gtgteqquestion acc
              (fun function_parameter =>
                let '(ctxt, balance_updates) := function_parameter in
                op_gtgteqquestion
                  (burn_fees ctxt
                    (Tezos_raw_protocol_alpha.Nonce_storage.unrevealed.delegate
                      u) revealed_cycle
                    (Tezos_raw_protocol_alpha.Nonce_storage.unrevealed.fees u))
                  (fun ctxt =>
                    op_gtgteqquestion
                      (burn_rewards ctxt
                        (Tezos_raw_protocol_alpha.Nonce_storage.unrevealed.delegate
                          u) revealed_cycle
                        (Tezos_raw_protocol_alpha.Nonce_storage.unrevealed.rewards
                          u))
                      (fun ctxt =>
                        let bus :=
                          cons
                            ((Fees
                              (Tezos_raw_protocol_alpha.Nonce_storage.unrevealed.delegate
                                u) revealed_cycle),
                              (Debited
                                (Tezos_raw_protocol_alpha.Nonce_storage.unrevealed.fees
                                  u)))
                            (cons
                              ((Rewards
                                (Tezos_raw_protocol_alpha.Nonce_storage.unrevealed.delegate
                                  u) revealed_cycle),
                                (Debited
                                  (Tezos_raw_protocol_alpha.Nonce_storage.unrevealed.rewards
                                    u))) []) in
                        __return (ctxt, (op_at bus balance_updates))))))
        (__return (ctxt, [])) unrevealed
    end
    (fun function_parameter =>
      let '(ctxt, balance_updates) := function_parameter in
      match Cycle_repr.sub last_cycle preserved with
      | None => __return (ctxt, balance_updates, [])
      | Some unfrozen_cycle =>
        op_gtgteqquestion
          (Storage.Delegates_with_frozen_balance.fold (ctxt, unfrozen_cycle)
            (Tezos_protocol_environment_alpha__Environment.Pervasives.Ok
              (ctxt, balance_updates))
            (fun delegate =>
              fun acc =>
                op_gtgteqquestion (Lwt.__return acc)
                  (fun function_parameter =>
                    let '(ctxt, bus) := function_parameter in
                    op_gtgteqquestion (unfreeze ctxt delegate unfrozen_cycle)
                      (fun function_parameter =>
                        let '(ctxt, balance_updates) := function_parameter in
                        __return (ctxt, (op_at balance_updates bus))))))
          (fun function_parameter =>
            let '(ctxt, balance_updates) := function_parameter in
            op_gtgteq
              (Storage.Delegates_with_frozen_balance.clear
                (ctxt, unfrozen_cycle))
              (fun ctxt =>
                op_gtgteqquestion
                  (Storage.Active_delegates_with_rolls.fold ctxt
                    (Tezos_protocol_environment_alpha__Environment.Pervasives.Ok
                      (ctxt, []))
                    (fun delegate =>
                      fun acc =>
                        op_gtgteqquestion (Lwt.__return acc)
                          (fun function_parameter =>
                            let '(ctxt, deactivated) := function_parameter in
                            op_gtgteqquestion
                              (Storage.Contract.Delegate_desactivation.get ctxt
                                (Contract_repr.implicit_contract delegate))
                              (fun cycle =>
                                if op_lteq cycle last_cycle then
                                  op_gtgteqquestion
                                    (Roll_storage.Delegate.set_inactive ctxt
                                      delegate)
                                    (fun ctxt =>
                                      __return
                                        (ctxt, (cons delegate deactivated)))
                                else
                                  __return (ctxt, deactivated)))))
                  (fun function_parameter =>
                    let '(ctxt, deactivated) := function_parameter in
                    __return (ctxt, balance_updates, deactivated))))
      end).

Definition punish
  (ctxt : Tezos_raw_protocol_alpha.Raw_context.t)
  (delegate :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  (cycle : Tezos_raw_protocol_alpha.Storage.Contract.Frozen_deposits.key)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Raw_context.t * frozen_balance)) :=
  let contract := Contract_repr.implicit_contract delegate in
  op_gtgteqquestion (get_frozen_deposit ctxt contract cycle)
    (fun deposit =>
      op_gtgteqquestion (get_frozen_fees ctxt contract cycle)
        (fun fees =>
          op_gtgteqquestion (get_frozen_rewards ctxt contract cycle)
            (fun rewards =>
              op_gtgteqquestion
                (Roll_storage.Delegate.remove_amount ctxt delegate deposit)
                (fun ctxt =>
                  op_gtgteqquestion
                    (Roll_storage.Delegate.remove_amount ctxt delegate fees)
                    (fun ctxt =>
                      op_gtgteq
                        (Storage.Contract.Frozen_deposits.remove
                          (ctxt, contract) cycle)
                        (fun ctxt =>
                          op_gtgteq
                            (Storage.Contract.Frozen_fees.remove
                              (ctxt, contract) cycle)
                            (fun ctxt =>
                              op_gtgteq
                                (Storage.Contract.Frozen_rewards.remove
                                  (ctxt, contract) cycle)
                                (fun ctxt =>
                                  __return
                                    (ctxt,
                                      {| frozen_balance.deposit := deposit;
                                        frozen_balance.fees := fees;
                                        frozen_balance.rewards := rewards |}))))))))).

Definition has_frozen_balance
  (ctxt : Tezos_raw_protocol_alpha.Raw_context.t)
  (delegate :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  (cycle : Tezos_raw_protocol_alpha.Storage.Contract.Frozen_deposits.key)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult bool) :=
  let contract := Contract_repr.implicit_contract delegate in
  op_gtgteqquestion (get_frozen_deposit ctxt contract cycle)
    (fun deposit =>
      if op_ltgt deposit zero then
        return_true
      else
        op_gtgteqquestion (get_frozen_fees ctxt contract cycle)
          (fun fees =>
            if op_ltgt fees zero then
              return_true
            else
              op_gtgteqquestion (get_frozen_rewards ctxt contract cycle)
                (fun rewards => __return (op_ltgt rewards zero)))).

Definition frozen_balance_by_cycle_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    (Tezos_raw_protocol_alpha.Cycle_repr.Map.t frozen_balance) :=
  conv Cycle_repr.Map.bindings
    (List.fold_left
      (fun m =>
        fun function_parameter =>
          let '(c, b) := function_parameter in
          Cycle_repr.Map.add c b m) Cycle_repr.Map.empty) None
    (__list_value None
      (merge_objs (obj1 (req None None "cycle" % string Cycle_repr.encoding))
        frozen_balance_encoding)).

Definition empty_frozen_balance : frozen_balance :=
  {| frozen_balance.deposit := Tez_repr.zero;
    frozen_balance.fees := Tez_repr.zero;
    frozen_balance.rewards := Tez_repr.zero |}.

Definition frozen_balance_by_cycle
  (ctxt : Tezos_raw_protocol_alpha.Raw_context.t)
  (delegate :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_raw_protocol_alpha.Cycle_repr.Map.t frozen_balance) :=
  let contract := Contract_repr.implicit_contract delegate in
  let map := Cycle_repr.Map.empty in
  op_gtgteq
    (Storage.Contract.Frozen_deposits.fold (ctxt, contract) map
      (fun cycle =>
        fun amount =>
          fun map =>
            Lwt.__return
              (Cycle_repr.Map.add cycle
                (* ❌ Record substitution not handled *)
                record_substitution map)))
    (fun map =>
      op_gtgteq
        (Storage.Contract.Frozen_fees.fold (ctxt, contract) map
          (fun cycle =>
            fun amount =>
              fun map =>
                let balance :=
                  match Cycle_repr.Map.find_opt cycle map with
                  | None => empty_frozen_balance
                  | Some balance => balance
                  end in
                Lwt.__return
                  (Cycle_repr.Map.add cycle
                    (* ❌ Record substitution not handled *)
                    record_substitution map)))
        (fun map =>
          op_gtgteq
            (Storage.Contract.Frozen_rewards.fold (ctxt, contract) map
              (fun cycle =>
                fun amount =>
                  fun map =>
                    let balance :=
                      match Cycle_repr.Map.find_opt cycle map with
                      | None => empty_frozen_balance
                      | Some balance => balance
                      end in
                    Lwt.__return
                      (Cycle_repr.Map.add cycle
                        (* ❌ Record substitution not handled *)
                        record_substitution map))) (fun map => Lwt.__return map))).

Definition frozen_balance
  (ctxt : Tezos_raw_protocol_alpha.Raw_context.t)
  (delegate :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Pervasives.result
      Tezos_raw_protocol_alpha.Tez_repr.t
      (list Tezos_protocol_environment_alpha__Environment.Error_monad.__error)) :=
  let contract := Contract_repr.implicit_contract delegate in
  let balance :=
    Tezos_protocol_environment_alpha__Environment.Pervasives.Ok Tez_repr.zero in
  op_gtgteq
    (Storage.Contract.Frozen_deposits.fold (ctxt, contract) balance
      (fun _cycle =>
        fun amount =>
          fun acc =>
            op_gtgteqquestion (Lwt.__return acc)
              (fun acc => Lwt.__return (op_plusquestion acc amount))))
    (fun balance =>
      op_gtgteq
        (Storage.Contract.Frozen_fees.fold (ctxt, contract) balance
          (fun _cycle =>
            fun amount =>
              fun acc =>
                op_gtgteqquestion (Lwt.__return acc)
                  (fun acc => Lwt.__return (op_plusquestion acc amount))))
        (fun balance =>
          op_gtgteq
            (Storage.Contract.Frozen_rewards.fold (ctxt, contract) balance
              (fun _cycle =>
                fun amount =>
                  fun acc =>
                    op_gtgteqquestion (Lwt.__return acc)
                      (fun acc => Lwt.__return (op_plusquestion acc amount))))
            (fun balance => Lwt.__return balance))).

Definition full_balance
  (ctxt : Tezos_raw_protocol_alpha.Raw_context.t)
  (delegate :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Tez_repr.t) :=
  let contract := Contract_repr.implicit_contract delegate in
  op_gtgteqquestion (frozen_balance ctxt delegate)
    (fun frozen_balance =>
      op_gtgteqquestion (Storage.Contract.Balance.get ctxt contract)
        (fun balance => Lwt.__return (op_plusquestion frozen_balance balance))).

Definition deactivated
  : Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult bool) :=
  Roll_storage.Delegate.is_inactive.

Definition grace_period
  (ctxt :
    Tezos_raw_protocol_alpha.Storage.Contract.Delegate_desactivation.context)
  (delegate :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Storage.Contract.Delegate_desactivation.value) :=
  let contract := Contract_repr.implicit_contract delegate in
  Storage.Contract.Delegate_desactivation.get ctxt contract.

Definition staking_balance
  (ctxt : Tezos_raw_protocol_alpha.Raw_context.context)
  (delegate :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Tez_repr.t) :=
  let token_per_rolls := Constants_storage.tokens_per_roll ctxt in
  op_gtgteqquestion (Roll_storage.get_rolls ctxt delegate)
    (fun rolls =>
      op_gtgteqquestion (Roll_storage.get_change ctxt delegate)
        (fun change =>
          let rolls := Int64.of_int (List.length rolls) in
          op_gtgteqquestion
            (Lwt.__return (op_starquestion token_per_rolls rolls))
            (fun balance => Lwt.__return (op_plusquestion balance change)))).

Definition delegated_balance
  (ctxt : Tezos_raw_protocol_alpha.Raw_context.context)
  (delegate :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Tez_repr.t) :=
  let contract := Contract_repr.implicit_contract delegate in
  op_gtgteqquestion (staking_balance ctxt delegate)
    (fun staking_balance =>
      op_gtgteq (Storage.Contract.Balance.get ctxt contract)
        (fun self_staking_balance =>
          op_gtgteq
            (Storage.Contract.Frozen_deposits.fold (ctxt, contract)
              self_staking_balance
              (fun _cycle =>
                fun amount =>
                  fun acc =>
                    op_gtgteqquestion (Lwt.__return acc)
                      (fun acc => Lwt.__return (op_plusquestion acc amount))))
            (fun self_staking_balance =>
              op_gtgteqquestion
                (Storage.Contract.Frozen_fees.fold (ctxt, contract)
                  self_staking_balance
                  (fun _cycle =>
                    fun amount =>
                      fun acc =>
                        op_gtgteqquestion (Lwt.__return acc)
                          (fun acc => Lwt.__return (op_plusquestion acc amount))))
                (fun self_staking_balance =>
                  Lwt.__return
                    (op_minusquestion staking_balance self_staking_balance))))).

Definition fold {A : Set}
  : Tezos_raw_protocol_alpha.Storage.Delegates.context -> A ->
  (Tezos_raw_protocol_alpha.Storage.Delegates.elt -> A ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t A) ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t A :=
  Storage.Delegates.fold.

Definition __list_value
  : Tezos_raw_protocol_alpha.Storage.Delegates.context ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (list Tezos_raw_protocol_alpha.Storage.Delegates.elt) :=
  Storage.Delegates.elements.

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

(** Places where tezzies can be found in the ledger's state. *)
type balance =
  | Contract of Contract_repr.t
  | Rewards of Signature.Public_key_hash.t * Cycle_repr.t
  | Fees of Signature.Public_key_hash.t * Cycle_repr.t
  | Deposits of Signature.Public_key_hash.t * Cycle_repr.t

(** A credit or debit of tezzies to a balance. *)
type balance_update = Debited of Tez_repr.t | Credited of Tez_repr.t

(** A list of balance updates. Duplicates may happen. *)
type balance_updates = (balance * balance_update) list

val balance_updates_encoding : balance_updates Data_encoding.t

(** Remove zero-valued balances from a list of updates. *)
val cleanup_balance_updates : balance_updates -> balance_updates

type frozen_balance = {
  deposit : Tez_repr.t;
  fees : Tez_repr.t;
  rewards : Tez_repr.t;
}

(** Allow to register a delegate when creating an account. *)
val init :
  Raw_context.t ->
  Contract_repr.t ->
  Signature.Public_key_hash.t ->
  Raw_context.t tzresult Lwt.t

(** Cleanup delegation when deleting a contract. *)
val remove : Raw_context.t -> Contract_repr.t -> Raw_context.t tzresult Lwt.t

(** Reading the current delegate of a contract. *)
val get :
  Raw_context.t ->
  Contract_repr.t ->
  Signature.Public_key_hash.t option tzresult Lwt.t

val registered :
  Raw_context.t -> Signature.Public_key_hash.t -> bool tzresult Lwt.t

(** Updating the delegate of a contract.

    When calling this function on an "implicit contract" and setting
    the delegate to the contract manager registers it as a delegate. One
    cannot unregister a delegate for now. The associate contract is now
    'undeletable'. *)
val set :
  Raw_context.t ->
  Contract_repr.t ->
  Signature.Public_key_hash.t option ->
  Raw_context.t tzresult Lwt.t

type error +=
  | No_deletion of Signature.Public_key_hash.t (* `Permanent *)
  | Active_delegate (* `Temporary *)
  | Current_delegate (* `Temporary *)
  | Empty_delegate_account of Signature.Public_key_hash.t (* `Temporary *)
  | Balance_too_low_for_deposit of {
      delegate : Signature.Public_key_hash.t;
      deposit : Tez_repr.t;
      balance : Tez_repr.t;
    }

(* `Temporary *)

(** Iterate on all registered delegates. *)
val fold :
  Raw_context.t ->
  init:'a ->
  f:(Signature.Public_key_hash.t -> 'a -> 'a Lwt.t) ->
  'a Lwt.t

(** List all registered delegates. *)
val list : Raw_context.t -> Signature.Public_key_hash.t list Lwt.t

(** Various functions to 'freeze' tokens.  A frozen 'deposit' keeps its
    associated rolls. When frozen, 'fees' may trigger new rolls
    allocation. Rewards won't trigger new rolls allocation until
    unfrozen. *)
val freeze_deposit :
  Raw_context.t ->
  Signature.Public_key_hash.t ->
  Tez_repr.t ->
  Raw_context.t tzresult Lwt.t

val freeze_fees :
  Raw_context.t ->
  Signature.Public_key_hash.t ->
  Tez_repr.t ->
  Raw_context.t tzresult Lwt.t

val freeze_rewards :
  Raw_context.t ->
  Signature.Public_key_hash.t ->
  Tez_repr.t ->
  Raw_context.t tzresult Lwt.t

(** Trigger the context maintenance at the end of cycle 'n', i.e.:
    unfreeze deposit/fees/rewards from 'n - preserved_cycle' ; punish the
    provided unrevealed seeds (tipically seed from cycle 'n - 1').
    Returns a list of account with the amount that was unfrozen for each
    and the list of deactivated delegates. *)
val cycle_end :
  Raw_context.t ->
  Cycle_repr.t ->
  Nonce_storage.unrevealed list ->
  (Raw_context.t * balance_updates * Signature.Public_key_hash.t list) tzresult
  Lwt.t

(** Burn all then frozen deposit/fees/rewards for a delegate at a given
    cycle. Returns the burned amounts. *)
val punish :
  Raw_context.t ->
  Signature.Public_key_hash.t ->
  Cycle_repr.t ->
  (Raw_context.t * frozen_balance) tzresult Lwt.t

(** Has the given key some frozen tokens in its implicit contract? *)
val has_frozen_balance :
  Raw_context.t ->
  Signature.Public_key_hash.t ->
  Cycle_repr.t ->
  bool tzresult Lwt.t

(** Returns the amount of frozen deposit, fees and rewards associated
    to a given delegate. *)
val frozen_balance :
  Raw_context.t -> Signature.Public_key_hash.t -> Tez_repr.t tzresult Lwt.t

val frozen_balance_encoding : frozen_balance Data_encoding.t

val frozen_balance_by_cycle_encoding :
  frozen_balance Cycle_repr.Map.t Data_encoding.t

(** Returns the amount of frozen deposit, fees and rewards associated
    to a given delegate, indexed by the cycle by which at the end the
    balance will be unfrozen. *)
val frozen_balance_by_cycle :
  Raw_context.t ->
  Signature.Public_key_hash.t ->
  frozen_balance Cycle_repr.Map.t Lwt.t

(** Returns the full 'balance' of the implicit contract associated to
    a given key, i.e. the sum of the spendable balance and of the
    frozen balance. *)
val full_balance :
  Raw_context.t -> Signature.Public_key_hash.t -> Tez_repr.t tzresult Lwt.t

val staking_balance :
  Raw_context.t -> Signature.Public_key_hash.t -> Tez_repr.t tzresult Lwt.t

(** Returns the list of contracts (implicit or originated) that delegated towards a given delegate *)
val delegated_contracts :
  Raw_context.t -> Signature.Public_key_hash.t -> Contract_repr.t list Lwt.t

val delegated_balance :
  Raw_context.t -> Signature.Public_key_hash.t -> Tez_repr.t tzresult Lwt.t

val deactivated :
  Raw_context.t -> Signature.Public_key_hash.t -> bool tzresult Lwt.t

val grace_period :
  Raw_context.t -> Signature.Public_key_hash.t -> Cycle_repr.t tzresult Lwt.t

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Inductive balance : Set :=
| Contract : Tezos_raw_protocol_alpha.Contract_repr.t -> balance
| Rewards :
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Tezos_raw_protocol_alpha.Cycle_repr.t -> balance
| Fees :
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Tezos_raw_protocol_alpha.Cycle_repr.t -> balance
| Deposits :
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Tezos_raw_protocol_alpha.Cycle_repr.t -> balance.

Inductive balance_update : Set :=
| Debited : Tezos_raw_protocol_alpha.Tez_repr.t -> balance_update
| Credited : Tezos_raw_protocol_alpha.Tez_repr.t -> balance_update.

Definition balance_updates := list (balance * balance_update).

Parameter balance_updates_encoding :
  Tezos_protocol_environment_alpha__Environment.Data_encoding.t balance_updates.

Parameter cleanup_balance_updates : balance_updates -> balance_updates.

Module frozen_balance.
  Record record := {
    deposit : Tezos_raw_protocol_alpha.Tez_repr.t;
    fees : Tezos_raw_protocol_alpha.Tez_repr.t;
    rewards : Tezos_raw_protocol_alpha.Tez_repr.t }.
End frozen_balance.
Definition frozen_balance := frozen_balance.record.

Parameter init :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Contract_repr.t ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t).

Parameter remove :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Contract_repr.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t).

Parameter get :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Contract_repr.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (option
        Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)).

Parameter registered :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult bool).

Parameter set :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Contract_repr.t ->
  option
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t).

(* extensible_type Tezos_protocol_environment_alpha__Environment.Error_monad.error *)

Parameter fold : forall {a : Set},
  Tezos_raw_protocol_alpha.Raw_context.t -> a ->
  (Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  a -> Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t a.

Parameter __list_value :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (list
      Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t).

Parameter freeze_deposit :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Tezos_raw_protocol_alpha.Tez_repr.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t).

Parameter freeze_fees :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Tezos_raw_protocol_alpha.Tez_repr.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t).

Parameter freeze_rewards :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Tezos_raw_protocol_alpha.Tez_repr.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t).

Parameter cycle_end :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Cycle_repr.t ->
  list Tezos_raw_protocol_alpha.Nonce_storage.unrevealed ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Raw_context.t * balance_updates *
        list
          Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)).

Parameter punish :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Tezos_raw_protocol_alpha.Cycle_repr.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Raw_context.t * frozen_balance)).

Parameter has_frozen_balance :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Tezos_raw_protocol_alpha.Cycle_repr.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult bool).

Parameter frozen_balance :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Tez_repr.t).

Parameter frozen_balance_encoding :
  Tezos_protocol_environment_alpha__Environment.Data_encoding.t frozen_balance.

Parameter frozen_balance_by_cycle_encoding :
  Tezos_protocol_environment_alpha__Environment.Data_encoding.t
    (Tezos_raw_protocol_alpha.Cycle_repr.Map.t frozen_balance).

Parameter frozen_balance_by_cycle :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_raw_protocol_alpha.Cycle_repr.Map.t frozen_balance).

Parameter full_balance :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Tez_repr.t).

Parameter staking_balance :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Tez_repr.t).

Parameter delegated_contracts :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (list Tezos_raw_protocol_alpha.Contract_repr.t).

Parameter delegated_balance :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Tez_repr.t).

Parameter deactivated :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult bool).

Parameter grace_period :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Cycle_repr.t).

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

type error += Cannot_pay_storage_fee (* `Temporary *)

type error += Operation_quota_exceeded (* `Temporary *)

type error += Storage_limit_too_high (* `Permanent *)

let () =
  let open Data_encoding in
  register_error_kind
    `Temporary
    ~id:"contract.cannot_pay_storage_fee"
    ~title:"Cannot pay storage fee"
    ~description:"The storage fee is higher than the contract balance"
    ~pp:(fun ppf () -> Format.fprintf ppf "Cannot pay storage storage fee")
    Data_encoding.empty
    (function Cannot_pay_storage_fee -> Some () | _ -> None)
    (fun () -> Cannot_pay_storage_fee) ;
  register_error_kind
    `Temporary
    ~id:"storage_exhausted.operation"
    ~title:"Storage quota exceeded for the operation"
    ~description:
      "A script or one of its callee wrote more bytes than the operation said \
       it would"
    Data_encoding.empty
    (function Operation_quota_exceeded -> Some () | _ -> None)
    (fun () -> Operation_quota_exceeded) ;
  register_error_kind
    `Permanent
    ~id:"storage_limit_too_high"
    ~title:"Storage limit out of protocol hard bounds"
    ~description:"A transaction tried to exceed the hard limit on storage"
    empty
    (function Storage_limit_too_high -> Some () | _ -> None)
    (fun () -> Storage_limit_too_high)

let origination_burn c =
  let origination_size = Constants_storage.origination_size c in
  let cost_per_byte = Constants_storage.cost_per_byte c in
  (* the origination burn, measured in bytes *)
  Lwt.return Tez_repr.(cost_per_byte *? Int64.of_int origination_size)
  >>=? fun to_be_paid ->
  return (Raw_context.update_allocated_contracts_count c, to_be_paid)

let record_paid_storage_space c contract =
  Contract_storage.used_storage_space c contract
  >>=? fun size ->
  Contract_storage.set_paid_storage_space_and_return_fees_to_pay
    c
    contract
    size
  >>=? fun (to_be_paid, c) ->
  let c = Raw_context.update_storage_space_to_pay c to_be_paid in
  let cost_per_byte = Constants_storage.cost_per_byte c in
  Lwt.return Tez_repr.(cost_per_byte *? Z.to_int64 to_be_paid)
  >>=? fun to_burn -> return (c, size, to_be_paid, to_burn)

let burn_storage_fees c ~storage_limit ~payer =
  let origination_size = Constants_storage.origination_size c in
  let (c, storage_space_to_pay, allocated_contracts) =
    Raw_context.clear_storage_space_to_pay c
  in
  let storage_space_for_allocated_contracts =
    Z.mul (Z.of_int allocated_contracts) (Z.of_int origination_size)
  in
  let consumed =
    Z.add storage_space_to_pay storage_space_for_allocated_contracts
  in
  let remaining = Z.sub storage_limit consumed in
  if Compare.Z.(remaining < Z.zero) then fail Operation_quota_exceeded
  else
    let cost_per_byte = Constants_storage.cost_per_byte c in
    Lwt.return Tez_repr.(cost_per_byte *? Z.to_int64 consumed)
    >>=? fun to_burn ->
    (* Burning the fees... *)
    if Tez_repr.(to_burn = Tez_repr.zero) then
      (* If the payer was was deleted by transfering all its balance, and no space was used,
         burning zero would fail *)
      return c
    else
      trace
        Cannot_pay_storage_fee
        ( Contract_storage.must_exist c payer
        >>=? fun () -> Contract_storage.spend c payer to_burn )
      >>=? fun c -> return c

let check_storage_limit c ~storage_limit =
  if
    Compare.Z.(
      storage_limit
      > (Raw_context.constants c).hard_storage_limit_per_operation)
    || Compare.Z.(storage_limit < Z.zero)
  then error Storage_limit_too_high
  else ok ()

let start_counting_storage_fees c = Raw_context.init_storage_space_to_pay c

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Top-level evaluations are considered as an error as sources of side-effects *)
Compute
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "contract.cannot_pay_storage_fee" % string
      "Cannot pay storage fee" % string
      "The storage fee is higher than the contract balance" % string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let 'tt := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Cannot pay storage storage fee" % string
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
                "Cannot pay storage storage fee" % string))) Data_encoding.empty
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Cannot_pay_storage_fee
          => Some tt
        | _ => None
        end)
      (fun function_parameter =>
        let 'tt := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Cannot_pay_storage_fee)
    in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "storage_exhausted.operation" % string
      "Storage quota exceeded for the operation" % string
      "A script or one of its callee wrote more bytes than the operation said it would"
        % string None Data_encoding.empty
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Operation_quota_exceeded
          => Some tt
        | _ => None
        end)
      (fun function_parameter =>
        let 'tt := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Operation_quota_exceeded)
    in
  register_error_kind
    (* ❌ Variants not supported *)
    variant "storage_limit_too_high" % string
    "Storage limit out of protocol hard bounds" % string
    "A transaction tried to exceed the hard limit on storage" % string None
    empty
    (fun function_parameter =>
      match function_parameter with
      |
        Tezos_protocol_environment_alpha__Environment.Error_monad.Storage_limit_too_high
        => Some tt
      | _ => None
      end)
    (fun function_parameter =>
      let 'tt := function_parameter in
      Tezos_protocol_environment_alpha__Environment.Error_monad.Storage_limit_too_high).

Definition origination_burn (c : Tezos_raw_protocol_alpha.Raw_context.context)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Raw_context.t *
        Tezos_raw_protocol_alpha.Tez_repr.t)) :=
  let origination_size := Constants_storage.origination_size c in
  let cost_per_byte := Constants_storage.cost_per_byte c in
  op_gtgteqquestion
    (Lwt.__return
      (op_starquestion cost_per_byte (Int64.of_int origination_size)))
    (fun to_be_paid =>
      __return ((Raw_context.update_allocated_contracts_count c), to_be_paid)).

Definition record_paid_storage_space
  (c : Tezos_raw_protocol_alpha.Raw_context.t)
  (contract : Tezos_raw_protocol_alpha.Contract_repr.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Raw_context.t *
        Tezos_protocol_environment_alpha__Environment.Z.t *
        Tezos_protocol_environment_alpha__Environment.Z.t *
        Tezos_raw_protocol_alpha.Tez_repr.t)) :=
  op_gtgteqquestion (Contract_storage.used_storage_space c contract)
    (fun size =>
      op_gtgteqquestion
        (Contract_storage.set_paid_storage_space_and_return_fees_to_pay c
          contract size)
        (fun function_parameter =>
          let '(to_be_paid, c) := function_parameter in
          let c := Raw_context.update_storage_space_to_pay c to_be_paid in
          let cost_per_byte := Constants_storage.cost_per_byte c in
          op_gtgteqquestion
            (Lwt.__return
              (op_starquestion cost_per_byte (Z.to_int64 to_be_paid)))
            (fun to_burn => __return (c, size, to_be_paid, to_burn)))).

Definition burn_storage_fees
  (c : Tezos_raw_protocol_alpha.Raw_context.context)
  (storage_limit : Tezos_protocol_environment_alpha__Environment.Z.t)
  (payer : Tezos_raw_protocol_alpha.Contract_repr.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  let origination_size := Constants_storage.origination_size c in
  let '(c, storage_space_to_pay, allocated_contracts) :=
    Raw_context.clear_storage_space_to_pay c in
  let storage_space_for_allocated_contracts :=
    Z.mul (Z.of_int allocated_contracts) (Z.of_int origination_size) in
  let consumed :=
    Z.add storage_space_to_pay storage_space_for_allocated_contracts in
  let remaining := Z.sub storage_limit consumed in
  if op_lt remaining Z.zero then
    fail
      Tezos_protocol_environment_alpha__Environment.Error_monad.Operation_quota_exceeded
  else
    let cost_per_byte := Constants_storage.cost_per_byte c in
    op_gtgteqquestion
      (Lwt.__return (op_starquestion cost_per_byte (Z.to_int64 consumed)))
      (fun to_burn =>
        if op_eq to_burn Tez_repr.zero then
          __return c
        else
          op_gtgteqquestion
            (trace
              Tezos_protocol_environment_alpha__Environment.Error_monad.Cannot_pay_storage_fee
              (op_gtgteqquestion (Contract_storage.must_exist c payer)
                (fun function_parameter =>
                  let 'tt := function_parameter in
                  Contract_storage.spend c payer to_burn)))
            (fun c => __return c)).

Definition check_storage_limit
  (c : Tezos_raw_protocol_alpha.Raw_context.context)
  (storage_limit : Tezos_protocol_environment_alpha__Environment.Compare.Z.t)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit :=
  if
    op_pipepipe
      (op_gt storage_limit
        (Tezos_raw_protocol_alpha.Constants_repr.parametric.hard_storage_limit_per_operation
          (Raw_context.constants c))) (op_lt storage_limit Z.zero) then
    __error_value
      Tezos_protocol_environment_alpha__Environment.Error_monad.Storage_limit_too_high
  else
    ok tt.

Definition start_counting_storage_fees
  (c : Tezos_raw_protocol_alpha.Raw_context.t)
  : Tezos_raw_protocol_alpha.Raw_context.t :=
  Raw_context.init_storage_space_to_pay c.

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

type error += Cannot_pay_storage_fee (* `Temporary *)

type error += Operation_quota_exceeded (* `Temporary *)

type error += Storage_limit_too_high (* `Permanent *)

(** Does not burn, only adds the burn to storage space to be paid *)
val origination_burn :
  Raw_context.t -> (Raw_context.t * Tez_repr.t) tzresult Lwt.t

(** The returned Tez quantity is for logging purpose only *)
val record_paid_storage_space :
  Raw_context.t ->
  Contract_repr.t ->
  (Raw_context.t * Z.t * Z.t * Tez_repr.t) tzresult Lwt.t

val check_storage_limit : Raw_context.t -> storage_limit:Z.t -> unit tzresult

val start_counting_storage_fees : Raw_context.t -> Raw_context.t

val burn_storage_fees :
  Raw_context.t ->
  storage_limit:Z.t ->
  payer:Contract_repr.t ->
  Raw_context.t tzresult Lwt.t

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

(* extensible_type Tezos_protocol_environment_alpha__Environment.Error_monad.error *)

(* extensible_type Tezos_protocol_environment_alpha__Environment.Error_monad.error *)

(* extensible_type Tezos_protocol_environment_alpha__Environment.Error_monad.error *)

Parameter origination_burn :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Raw_context.t *
        Tezos_raw_protocol_alpha.Tez_repr.t)).

Parameter record_paid_storage_space :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Contract_repr.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Raw_context.t *
        Tezos_protocol_environment_alpha__Environment.Z.t *
        Tezos_protocol_environment_alpha__Environment.Z.t *
        Tezos_raw_protocol_alpha.Tez_repr.t)).

Parameter check_storage_limit :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Z.t ->
  Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit.

Parameter start_counting_storage_fees :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Raw_context.t.

Parameter burn_storage_fees :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Z.t ->
  Tezos_raw_protocol_alpha.Contract_repr.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t).

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

type error += Invalid_fitness (* `Permanent *)

let () =
  register_error_kind
    `Permanent
    ~id:"invalid_fitness"
    ~title:"Invalid fitness"
    ~description:"Fitness representation should be exactly 8 bytes long."
    ~pp:(fun ppf () -> Format.fprintf ppf "Invalid fitness")
    Data_encoding.empty
    (function Invalid_fitness -> Some () | _ -> None)
    (fun () -> Invalid_fitness)

let int64_to_bytes i =
  let b = MBytes.create 8 in
  MBytes.set_int64 b 0 i ; b

let int64_of_bytes b =
  if Compare.Int.(MBytes.length b <> 8) then error Invalid_fitness
  else ok (MBytes.get_int64 b 0)

let from_int64 fitness =
  [MBytes.of_string Constants_repr.version_number; int64_to_bytes fitness]

let to_int64 = function
  | [version; fitness]
    when Compare.String.(
           MBytes.to_string version = Constants_repr.version_number) ->
      int64_of_bytes fitness
  | [version; _fitness (* ignored since higher version takes priority *)]
    when Compare.String.(
           MBytes.to_string version = Constants_repr.version_number_004) ->
      ok 0L
  | [] ->
      ok 0L
  | _ ->
      error Invalid_fitness

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Top-level evaluations are considered as an error as sources of side-effects *)
Compute
  register_error_kind
    (* ❌ Variants not supported *)
    variant "invalid_fitness" % string "Invalid fitness" % string
    "Fitness representation should be exactly 8 bytes long." % string
    (Some
      (fun ppf =>
        fun function_parameter =>
          let 'tt := function_parameter in
          Format.fprintf ppf
            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                "Invalid fitness" % string
                Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
              "Invalid fitness" % string))) Data_encoding.empty
    (fun function_parameter =>
      match function_parameter with
      |
        Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_fitness
        => Some tt
      | _ => None
      end)
    (fun function_parameter =>
      let 'tt := function_parameter in
      Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_fitness).

Definition int64_to_bytes (i : int64)
  : Tezos_protocol_environment_alpha__Environment.MBytes.t :=
  let b := MBytes.create 8 in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ := MBytes.set_int64 b 0 i in
  b.

Definition int64_of_bytes
  (b : Tezos_protocol_environment_alpha__Environment.MBytes.t)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult int64 :=
  if op_ltgt (MBytes.length b) 8 then
    __error_value
      Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_fitness
  else
    ok (MBytes.get_int64 b 0).

Definition from_int64 (fitness : int64)
  : list Tezos_protocol_environment_alpha__Environment.MBytes.t :=
  cons (MBytes.of_string Constants_repr.version_number)
    (cons (int64_to_bytes fitness) []).

Definition to_int64
  (function_parameter :
    list Tezos_protocol_environment_alpha__Environment.MBytes.t)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult int64 :=
  match function_parameter with
  | cons version (cons fitness []) => int64_of_bytes fitness
  | cons version (cons _fitness []) =>
    ok
      (* ❌ Constant of type int64 is converted to int *)
      0
  | [] =>
    ok
      (* ❌ Constant of type int64 is converted to int *)
      0
  | _ =>
    __error_value
      Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_fitness
  end.

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

let current = Raw_context.current_fitness

let increase ?(gap = 1) ctxt =
  let fitness = current ctxt in
  Raw_context.set_current_fitness ctxt (Int64.add (Int64.of_int gap) fitness)

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Definition current
  : Tezos_raw_protocol_alpha.Raw_context.context ->
  Tezos_protocol_environment_alpha__Environment.Int64.t :=
  Raw_context.current_fitness.

Definition increase (op_staroptstar : option Z)
  : Tezos_raw_protocol_alpha.Raw_context.context ->
  Tezos_raw_protocol_alpha.Raw_context.t :=
  let gap :=
    match op_staroptstar with
    | Some op_starsthstar => op_starsthstar
    | None => 1
    end in
  fun ctxt =>
    let fitness := current ctxt in
    Raw_context.set_current_fitness ctxt (Int64.add (Int64.of_int gap) fitness).

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

type t = Unaccounted | Limited of {remaining : Z.t}

type internal_gas = Z.t

type cost = {
  allocations : Z.t;
  steps : Z.t;
  reads : Z.t;
  writes : Z.t;
  bytes_read : Z.t;
  bytes_written : Z.t;
}

let encoding =
  let open Data_encoding in
  union
    [ case
        (Tag 0)
        ~title:"Limited"
        z
        (function Limited {remaining} -> Some remaining | _ -> None)
        (fun remaining -> Limited {remaining});
      case
        (Tag 1)
        ~title:"Unaccounted"
        (constant "unaccounted")
        (function Unaccounted -> Some () | _ -> None)
        (fun () -> Unaccounted) ]

let pp ppf = function
  | Unaccounted ->
      Format.fprintf ppf "unaccounted"
  | Limited {remaining} ->
      Format.fprintf ppf "%s units remaining" (Z.to_string remaining)

let cost_encoding =
  let open Data_encoding in
  conv
    (fun {allocations; steps; reads; writes; bytes_read; bytes_written} ->
      (allocations, steps, reads, writes, bytes_read, bytes_written))
    (fun (allocations, steps, reads, writes, bytes_read, bytes_written) ->
      {allocations; steps; reads; writes; bytes_read; bytes_written})
    (obj6
       (req "allocations" z)
       (req "steps" z)
       (req "reads" z)
       (req "writes" z)
       (req "bytes_read" z)
       (req "bytes_written" z))

let pp_cost ppf {allocations; steps; reads; writes; bytes_read; bytes_written}
    =
  Format.fprintf
    ppf
    "(steps: %s, allocs: %s, reads: %s (%s bytes), writes: %s (%s bytes))"
    (Z.to_string steps)
    (Z.to_string allocations)
    (Z.to_string reads)
    (Z.to_string bytes_read)
    (Z.to_string writes)
    (Z.to_string bytes_written)

type error += Block_quota_exceeded (* `Temporary *)

type error += Operation_quota_exceeded (* `Temporary *)

let allocation_weight = Z.of_int 2

let step_weight = Z.of_int 1

let read_base_weight = Z.of_int 100

let write_base_weight = Z.of_int 160

let byte_read_weight = Z.of_int 10

let byte_written_weight = Z.of_int 15

let rescaling_bits = 7

let rescaling_mask = Z.sub (Z.shift_left Z.one rescaling_bits) Z.one

let scale (z : Z.t) = Z.shift_left z rescaling_bits

let rescale (z : Z.t) = Z.shift_right z rescaling_bits

let cost_to_internal_gas (cost : cost) : internal_gas =
  Z.add
    (Z.add
       (Z.mul cost.allocations allocation_weight)
       (Z.mul cost.steps step_weight))
    (Z.add
       (Z.add
          (Z.mul cost.reads read_base_weight)
          (Z.mul cost.writes write_base_weight))
       (Z.add
          (Z.mul cost.bytes_read byte_read_weight)
          (Z.mul cost.bytes_written byte_written_weight)))

let internal_gas_to_gas internal_gas : Z.t * internal_gas =
  let gas = rescale internal_gas in
  let rest = Z.logand internal_gas rescaling_mask in
  (gas, rest)

let consume block_gas operation_gas internal_gas cost =
  match operation_gas with
  | Unaccounted ->
      ok (block_gas, Unaccounted, internal_gas)
  | Limited {remaining} ->
      let cost_internal_gas = cost_to_internal_gas cost in
      let total_internal_gas = Z.add cost_internal_gas internal_gas in
      let (gas, rest) = internal_gas_to_gas total_internal_gas in
      if Compare.Z.(gas > Z.zero) then
        let remaining = Z.sub remaining gas in
        let block_remaining = Z.sub block_gas gas in
        if Compare.Z.(remaining < Z.zero) then error Operation_quota_exceeded
        else if Compare.Z.(block_remaining < Z.zero) then
          error Block_quota_exceeded
        else ok (block_remaining, Limited {remaining}, rest)
      else ok (block_gas, operation_gas, total_internal_gas)

let check_enough block_gas operation_gas internal_gas cost =
  consume block_gas operation_gas internal_gas cost
  >|? fun (_block_remainig, _remaining, _internal_gas) -> ()

let internal_gas_zero : internal_gas = Z.zero

let alloc_cost n =
  {
    allocations = scale (Z.of_int (n + 1));
    steps = Z.zero;
    reads = Z.zero;
    writes = Z.zero;
    bytes_read = Z.zero;
    bytes_written = Z.zero;
  }

let alloc_bytes_cost n = alloc_cost ((n + 7) / 8)

let alloc_bits_cost n = alloc_cost ((n + 63) / 64)

let atomic_step_cost n =
  {
    allocations = Z.zero;
    steps = Z.of_int (2 * n);
    reads = Z.zero;
    writes = Z.zero;
    bytes_read = Z.zero;
    bytes_written = Z.zero;
  }

let step_cost n =
  {
    allocations = Z.zero;
    steps = scale (Z.of_int n);
    reads = Z.zero;
    writes = Z.zero;
    bytes_read = Z.zero;
    bytes_written = Z.zero;
  }

let free =
  {
    allocations = Z.zero;
    steps = Z.zero;
    reads = Z.zero;
    writes = Z.zero;
    bytes_read = Z.zero;
    bytes_written = Z.zero;
  }

let read_bytes_cost n =
  {
    allocations = Z.zero;
    steps = Z.zero;
    reads = scale Z.one;
    writes = Z.zero;
    bytes_read = scale n;
    bytes_written = Z.zero;
  }

let write_bytes_cost n =
  {
    allocations = Z.zero;
    steps = Z.zero;
    reads = Z.zero;
    writes = Z.one;
    bytes_read = Z.zero;
    bytes_written = scale n;
  }

let ( +@ ) x y =
  {
    allocations = Z.add x.allocations y.allocations;
    steps = Z.add x.steps y.steps;
    reads = Z.add x.reads y.reads;
    writes = Z.add x.writes y.writes;
    bytes_read = Z.add x.bytes_read y.bytes_read;
    bytes_written = Z.add x.bytes_written y.bytes_written;
  }

let ( *@ ) x y =
  {
    allocations = Z.mul (Z.of_int x) y.allocations;
    steps = Z.mul (Z.of_int x) y.steps;
    reads = Z.mul (Z.of_int x) y.reads;
    writes = Z.mul (Z.of_int x) y.writes;
    bytes_read = Z.mul (Z.of_int x) y.bytes_read;
    bytes_written = Z.mul (Z.of_int x) y.bytes_written;
  }

let alloc_mbytes_cost n = alloc_cost 12 +@ alloc_bytes_cost n

let () =
  let open Data_encoding in
  register_error_kind
    `Temporary
    ~id:"gas_exhausted.operation"
    ~title:"Gas quota exceeded for the operation"
    ~description:
      "A script or one of its callee took more time than the operation said \
       it would"
    empty
    (function Operation_quota_exceeded -> Some () | _ -> None)
    (fun () -> Operation_quota_exceeded) ;
  register_error_kind
    `Temporary
    ~id:"gas_exhausted.block"
    ~title:"Gas quota exceeded for the block"
    ~description:
      "The sum of gas consumed by all the operations in the block exceeds the \
       hard gas limit per block"
    empty
    (function Block_quota_exceeded -> Some () | _ -> None)
    (fun () -> Block_quota_exceeded)

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Inductive t : Set :=
| Unaccounted : t
| Limited : Tezos_protocol_environment_alpha__Environment.Z.t -> t.

Definition internal_gas := Tezos_protocol_environment_alpha__Environment.Z.t.

Module cost.
  Record record := {
    allocations : Tezos_protocol_environment_alpha__Environment.Z.t;
    steps : Tezos_protocol_environment_alpha__Environment.Z.t;
    reads : Tezos_protocol_environment_alpha__Environment.Z.t;
    writes : Tezos_protocol_environment_alpha__Environment.Z.t;
    bytes_read : Tezos_protocol_environment_alpha__Environment.Z.t;
    bytes_written : Tezos_protocol_environment_alpha__Environment.Z.t }.
End cost.
Definition cost := cost.record.

Definition encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding t :=
  union None
    (cons
      (__case_value "Limited" % string None
        (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag 0) z
        (fun function_parameter =>
          match function_parameter with
          | Limited {| t.Limited.remaining := remaining |} => Some remaining
          | _ => None
          end) (fun remaining => Limited {| t.Limited.remaining := remaining |}))
      (cons
        (__case_value "Unaccounted" % string None
          (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag 1)
          (constant "unaccounted" % string)
          (fun function_parameter =>
            match function_parameter with
            | Unaccounted => Some tt
            | _ => None
            end)
          (fun function_parameter =>
            let 'tt := function_parameter in
            Unaccounted)) [])).

Definition pp
  (ppf : Tezos_protocol_environment_alpha__Environment.Format.formatter)
  (function_parameter : t) : unit :=
  match function_parameter with
  | Unaccounted =>
    Format.fprintf ppf
      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
          "unaccounted" % string
          Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
        "unaccounted" % string)
  | Limited {| t.Limited.remaining := remaining |} =>
    Format.fprintf ppf
      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String
          Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
          (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
            " units remaining" % string
            Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format))
        "%s units remaining" % string) (Z.to_string remaining)
  end.

Definition cost_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding cost :=
  conv
    (fun function_parameter =>
      let '{|
        cost.allocations := allocations;
          cost.steps := steps;
          cost.reads := reads;
          cost.writes := writes;
          cost.bytes_read := bytes_read;
          cost.bytes_written := bytes_written
          |} := function_parameter in
      (allocations, steps, reads, writes, bytes_read, bytes_written))
    (fun function_parameter =>
      let '(allocations, steps, reads, writes, bytes_read, bytes_written) :=
        function_parameter in
      {| cost.allocations := allocations; cost.steps := steps;
        cost.reads := reads; cost.writes := writes;
        cost.bytes_read := bytes_read; cost.bytes_written := bytes_written |})
    None
    (obj6 (req None None "allocations" % string z)
      (req None None "steps" % string z) (req None None "reads" % string z)
      (req None None "writes" % string z)
      (req None None "bytes_read" % string z)
      (req None None "bytes_written" % string z)).

Definition pp_cost
  (ppf : Tezos_protocol_environment_alpha__Environment.Format.formatter)
  (function_parameter : cost) : unit :=
  let '{|
    cost.allocations := allocations;
      cost.steps := steps;
      cost.reads := reads;
      cost.writes := writes;
      cost.bytes_read := bytes_read;
      cost.bytes_written := bytes_written
      |} := function_parameter in
  Format.fprintf ppf
    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
        "(steps: " % string
        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String
          Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
          (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
            ", allocs: " % string
            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String
              Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                ", reads: " % string
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                    " (" % string
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String
                      Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
                      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                        " bytes), writes: " % string
                        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String
                          Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
                          (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                            " (" % string
                            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String
                              Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
                              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                                " bytes))" % string
                                Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))))))))))))
      "(steps: %s, allocs: %s, reads: %s (%s bytes), writes: %s (%s bytes))" %
        string) (Z.to_string steps) (Z.to_string allocations)
    (Z.to_string reads) (Z.to_string bytes_read) (Z.to_string writes)
    (Z.to_string bytes_written).

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

Definition allocation_weight
  : Tezos_protocol_environment_alpha__Environment.Z.t := Z.of_int 2.

Definition step_weight : Tezos_protocol_environment_alpha__Environment.Z.t :=
  Z.of_int 1.

Definition read_base_weight
  : Tezos_protocol_environment_alpha__Environment.Z.t := Z.of_int 100.

Definition write_base_weight
  : Tezos_protocol_environment_alpha__Environment.Z.t := Z.of_int 160.

Definition byte_read_weight
  : Tezos_protocol_environment_alpha__Environment.Z.t := Z.of_int 10.

Definition byte_written_weight
  : Tezos_protocol_environment_alpha__Environment.Z.t := Z.of_int 15.

Definition rescaling_bits : Z := 7.

Definition rescaling_mask : Tezos_protocol_environment_alpha__Environment.Z.t :=
  Z.sub (Z.shift_left Z.one rescaling_bits) Z.one.

Definition scale (z : Tezos_protocol_environment_alpha__Environment.Z.t)
  : Tezos_protocol_environment_alpha__Environment.Z.t :=
  Z.shift_left z rescaling_bits.

Definition rescale (z : Tezos_protocol_environment_alpha__Environment.Z.t)
  : Tezos_protocol_environment_alpha__Environment.Z.t :=
  Z.shift_right z rescaling_bits.

Definition cost_to_internal_gas (cost : cost) : internal_gas :=
  Z.add
    (Z.add (Z.mul (cost.allocations cost) allocation_weight)
      (Z.mul (cost.steps cost) step_weight))
    (Z.add
      (Z.add (Z.mul (cost.reads cost) read_base_weight)
        (Z.mul (cost.writes cost) write_base_weight))
      (Z.add (Z.mul (cost.bytes_read cost) byte_read_weight)
        (Z.mul (cost.bytes_written cost) byte_written_weight))).

Definition internal_gas_to_gas
  (internal_gas : Tezos_protocol_environment_alpha__Environment.Z.t)
  : Tezos_protocol_environment_alpha__Environment.Z.t * internal_gas :=
  let gas := rescale internal_gas in
  let rest := Z.logand internal_gas rescaling_mask in
  (gas, rest).

Definition consume
  (block_gas : Tezos_protocol_environment_alpha__Environment.Z.t)
  (operation_gas : t)
  (internal_gas : Tezos_protocol_environment_alpha__Environment.Z.t)
  (cost : cost)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (Tezos_protocol_environment_alpha__Environment.Z.t * t *
      Tezos_protocol_environment_alpha__Environment.Z.t) :=
  match operation_gas with
  | Unaccounted => ok (block_gas, Unaccounted, internal_gas)
  | Limited {| t.Limited.remaining := remaining |} =>
    let cost_internal_gas := cost_to_internal_gas cost in
    let total_internal_gas := Z.add cost_internal_gas internal_gas in
    let '(gas, rest) := internal_gas_to_gas total_internal_gas in
    if op_gt gas Z.zero then
      let remaining := Z.sub remaining gas in
      let block_remaining := Z.sub block_gas gas in
      if op_lt remaining Z.zero then
        __error_value
          Tezos_protocol_environment_alpha__Environment.Error_monad.Operation_quota_exceeded
      else
        if op_lt block_remaining Z.zero then
          __error_value
            Tezos_protocol_environment_alpha__Environment.Error_monad.Block_quota_exceeded
        else
          ok
            (block_remaining, (Limited {| t.Limited.remaining := remaining |}),
              rest)
    else
      ok (block_gas, operation_gas, total_internal_gas)
  end.

Definition check_enough
  (block_gas : Tezos_protocol_environment_alpha__Environment.Z.t)
  (operation_gas : t)
  (internal_gas : Tezos_protocol_environment_alpha__Environment.Z.t)
  (cost : cost)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit :=
  op_gtpipequestion (consume block_gas operation_gas internal_gas cost)
    (fun function_parameter =>
      let '(_block_remainig, _remaining, _internal_gas) := function_parameter in
      tt).

Definition internal_gas_zero : internal_gas := Z.zero.

Definition alloc_cost (n : Z) : cost :=
  {| cost.allocations := scale (Z.of_int (op_plus n 1)); cost.steps := Z.zero;
    cost.reads := Z.zero; cost.writes := Z.zero; cost.bytes_read := Z.zero;
    cost.bytes_written := Z.zero |}.

Definition alloc_bytes_cost (n : Z) : cost :=
  alloc_cost (op_div (op_plus n 7) 8).

Definition alloc_bits_cost (n : Z) : cost :=
  alloc_cost (op_div (op_plus n 63) 64).

Definition atomic_step_cost (n : Z) : cost :=
  {| cost.allocations := Z.zero; cost.steps := Z.of_int (op_star 2 n);
    cost.reads := Z.zero; cost.writes := Z.zero; cost.bytes_read := Z.zero;
    cost.bytes_written := Z.zero |}.

Definition step_cost (n : Z) : cost :=
  {| cost.allocations := Z.zero; cost.steps := scale (Z.of_int n);
    cost.reads := Z.zero; cost.writes := Z.zero; cost.bytes_read := Z.zero;
    cost.bytes_written := Z.zero |}.

Definition free : cost :=
  {| cost.allocations := Z.zero; cost.steps := Z.zero; cost.reads := Z.zero;
    cost.writes := Z.zero; cost.bytes_read := Z.zero;
    cost.bytes_written := Z.zero |}.

Definition read_bytes_cost
  (n : Tezos_protocol_environment_alpha__Environment.Z.t) : cost :=
  {| cost.allocations := Z.zero; cost.steps := Z.zero;
    cost.reads := scale Z.one; cost.writes := Z.zero;
    cost.bytes_read := scale n; cost.bytes_written := Z.zero |}.

Definition write_bytes_cost
  (n : Tezos_protocol_environment_alpha__Environment.Z.t) : cost :=
  {| cost.allocations := Z.zero; cost.steps := Z.zero; cost.reads := Z.zero;
    cost.writes := Z.one; cost.bytes_read := Z.zero;
    cost.bytes_written := scale n |}.

Definition op_plusat (x : cost) (y : cost) : cost :=
  {| cost.allocations := Z.add (cost.allocations x) (cost.allocations y);
    cost.steps := Z.add (cost.steps x) (cost.steps y);
    cost.reads := Z.add (cost.reads x) (cost.reads y);
    cost.writes := Z.add (cost.writes x) (cost.writes y);
    cost.bytes_read := Z.add (cost.bytes_read x) (cost.bytes_read y);
    cost.bytes_written := Z.add (cost.bytes_written x) (cost.bytes_written y) |}.

Definition op_starat (x : Z) (y : cost) : cost :=
  {| cost.allocations := Z.mul (Z.of_int x) (cost.allocations y);
    cost.steps := Z.mul (Z.of_int x) (cost.steps y);
    cost.reads := Z.mul (Z.of_int x) (cost.reads y);
    cost.writes := Z.mul (Z.of_int x) (cost.writes y);
    cost.bytes_read := Z.mul (Z.of_int x) (cost.bytes_read y);
    cost.bytes_written := Z.mul (Z.of_int x) (cost.bytes_written y) |}.

Definition alloc_mbytes_cost (n : Z) : cost :=
  op_plusat (alloc_cost 12) (alloc_bytes_cost n).

(* ❌ Top-level evaluations are considered as an error as sources of side-effects *)
Compute
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "gas_exhausted.operation" % string
      "Gas quota exceeded for the operation" % string
      "A script or one of its callee took more time than the operation said it would"
        % string None empty
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Operation_quota_exceeded
          => Some tt
        | _ => None
        end)
      (fun function_parameter =>
        let 'tt := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Operation_quota_exceeded)
    in
  register_error_kind
    (* ❌ Variants not supported *)
    variant "gas_exhausted.block" % string
    "Gas quota exceeded for the block" % string
    "The sum of gas consumed by all the operations in the block exceeds the hard gas limit per block"
      % string None empty
    (fun function_parameter =>
      match function_parameter with
      |
        Tezos_protocol_environment_alpha__Environment.Error_monad.Block_quota_exceeded
        => Some tt
      | _ => None
      end)
    (fun function_parameter =>
      let 'tt := function_parameter in
      Tezos_protocol_environment_alpha__Environment.Error_monad.Block_quota_exceeded).

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

type t = Unaccounted | Limited of {remaining : Z.t}

type internal_gas

val encoding : t Data_encoding.encoding

val pp : Format.formatter -> t -> unit

type cost

val cost_encoding : cost Data_encoding.encoding

val pp_cost : Format.formatter -> cost -> unit

type error += Block_quota_exceeded (* `Temporary *)

type error += Operation_quota_exceeded (* `Temporary *)

val consume :
  Z.t -> t -> internal_gas -> cost -> (Z.t * t * internal_gas) tzresult

val check_enough : Z.t -> t -> internal_gas -> cost -> unit tzresult

val internal_gas_zero : internal_gas

val free : cost

val atomic_step_cost : int -> cost

val step_cost : int -> cost

val alloc_cost : int -> cost

val alloc_bytes_cost : int -> cost

val alloc_mbytes_cost : int -> cost

val alloc_bits_cost : int -> cost

val read_bytes_cost : Z.t -> cost

val write_bytes_cost : Z.t -> cost

val ( *@ ) : int -> cost -> cost

val ( +@ ) : cost -> cost -> cost

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Inductive t : Set :=
| Unaccounted : t
| Limited : Tezos_protocol_environment_alpha__Environment.Z.t -> t.

Parameter internal_gas : Set.

Parameter encoding :
  Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding t.

Parameter pp :
  Tezos_protocol_environment_alpha__Environment.Format.formatter -> t -> unit.

Parameter cost : Set.

Parameter cost_encoding :
  Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding cost.

Parameter pp_cost :
  Tezos_protocol_environment_alpha__Environment.Format.formatter -> cost -> unit.

(* extensible_type Tezos_protocol_environment_alpha__Environment.Error_monad.error *)

(* extensible_type Tezos_protocol_environment_alpha__Environment.Error_monad.error *)

Parameter consume :
  Tezos_protocol_environment_alpha__Environment.Z.t -> t -> internal_gas ->
  cost ->
  Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (Tezos_protocol_environment_alpha__Environment.Z.t * t * internal_gas).

Parameter check_enough :
  Tezos_protocol_environment_alpha__Environment.Z.t -> t -> internal_gas ->
  cost ->
  Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit.

Parameter internal_gas_zero : internal_gas.

Parameter free : cost.

Parameter atomic_step_cost : Z -> cost.

Parameter step_cost : Z -> cost.

Parameter alloc_cost : Z -> cost.

Parameter alloc_bytes_cost : Z -> cost.

Parameter alloc_mbytes_cost : Z -> cost.

Parameter alloc_bits_cost : Z -> cost.

Parameter read_bytes_cost :
  Tezos_protocol_environment_alpha__Environment.Z.t -> cost.

Parameter write_bytes_cost :
  Tezos_protocol_environment_alpha__Environment.Z.t -> cost.

Parameter op_starat : Z -> cost -> cost.

Parameter op_plusat : cost -> cost -> cost.

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Alpha_context

type error += Cannot_parse_operation (* `Branch *)

let () =
  register_error_kind
    `Branch
    ~id:"operation.cannot_parse"
    ~title:"Cannot parse operation"
    ~description:"The operation is ill-formed or for another protocol version"
    ~pp:(fun ppf () -> Format.fprintf ppf "The operation cannot be parsed")
    Data_encoding.unit
    (function Cannot_parse_operation -> Some () | _ -> None)
    (fun () -> Cannot_parse_operation)

let parse_operation (op : Operation.raw) =
  match
    Data_encoding.Binary.of_bytes Operation.protocol_data_encoding op.proto
  with
  | Some protocol_data ->
      ok {shell = op.shell; protocol_data}
  | None ->
      error Cannot_parse_operation

let path = RPC_path.(open_root / "helpers")

module Scripts = struct
  module S = struct
    open Data_encoding

    let path = RPC_path.(path / "scripts")

    let run_code_input_encoding =
      obj9
        (req "script" Script.expr_encoding)
        (req "storage" Script.expr_encoding)
        (req "input" Script.expr_encoding)
        (req "amount" Tez.encoding)
        (req "chain_id" Chain_id.encoding)
        (opt "source" Contract.encoding)
        (opt "payer" Contract.encoding)
        (opt "gas" z)
        (dft "entrypoint" string "default")

    let trace_encoding =
      def "scripted.trace" @@ list
      @@ obj3
           (req "location" Script.location_encoding)
           (req "gas" Gas.encoding)
           (req
              "stack"
              (list
                 (obj2 (req "item" Script.expr_encoding) (opt "annot" string))))

    let run_code =
      RPC_service.post_service
        ~description:"Run a piece of code in the current context"
        ~query:RPC_query.empty
        ~input:run_code_input_encoding
        ~output:
          (obj3
             (req "storage" Script.expr_encoding)
             (req "operations" (list Operation.internal_operation_encoding))
             (opt "big_map_diff" Contract.big_map_diff_encoding))
        RPC_path.(path / "run_code")

    let trace_code =
      RPC_service.post_service
        ~description:
          "Run a piece of code in the current context, keeping a trace"
        ~query:RPC_query.empty
        ~input:run_code_input_encoding
        ~output:
          (obj4
             (req "storage" Script.expr_encoding)
             (req "operations" (list Operation.internal_operation_encoding))
             (req "trace" trace_encoding)
             (opt "big_map_diff" Contract.big_map_diff_encoding))
        RPC_path.(path / "trace_code")

    let typecheck_code =
      RPC_service.post_service
        ~description:"Typecheck a piece of code in the current context"
        ~query:RPC_query.empty
        ~input:(obj2 (req "program" Script.expr_encoding) (opt "gas" z))
        ~output:
          (obj2
             (req "type_map" Script_tc_errors_registration.type_map_enc)
             (req "gas" Gas.encoding))
        RPC_path.(path / "typecheck_code")

    let typecheck_data =
      RPC_service.post_service
        ~description:
          "Check that some data expression is well formed and of a given type \
           in the current context"
        ~query:RPC_query.empty
        ~input:
          (obj3
             (req "data" Script.expr_encoding)
             (req "type" Script.expr_encoding)
             (opt "gas" z))
        ~output:(obj1 (req "gas" Gas.encoding))
        RPC_path.(path / "typecheck_data")

    let pack_data =
      RPC_service.post_service
        ~description:
          "Computes the serialized version of some data expression using the \
           same algorithm as script instruction PACK"
        ~input:
          (obj3
             (req "data" Script.expr_encoding)
             (req "type" Script.expr_encoding)
             (opt "gas" z))
        ~output:(obj2 (req "packed" bytes) (req "gas" Gas.encoding))
        ~query:RPC_query.empty
        RPC_path.(path / "pack_data")

    let run_operation =
      RPC_service.post_service
        ~description:"Run an operation without signature checks"
        ~query:RPC_query.empty
        ~input:
          (obj2
             (req "operation" Operation.encoding)
             (req "chain_id" Chain_id.encoding))
        ~output:Apply_results.operation_data_and_metadata_encoding
        RPC_path.(path / "run_operation")

    let entrypoint_type =
      RPC_service.post_service
        ~description:"Return the type of the given entrypoint"
        ~query:RPC_query.empty
        ~input:
          (obj2
             (req "script" Script.expr_encoding)
             (dft "entrypoint" string "default"))
        ~output:(obj1 (req "entrypoint_type" Script.expr_encoding))
        RPC_path.(path / "entrypoint")

    let list_entrypoints =
      RPC_service.post_service
        ~description:"Return the list of entrypoints of the given script"
        ~query:RPC_query.empty
        ~input:(obj1 (req "script" Script.expr_encoding))
        ~output:
          (obj2
             (dft
                "unreachable"
                (Data_encoding.list
                   (obj1
                      (req
                         "path"
                         (Data_encoding.list
                            Michelson_v1_primitives.prim_encoding))))
                [])
             (req "entrypoints" (assoc Script.expr_encoding)))
        RPC_path.(path / "entrypoints")
  end

  let register () =
    let open Services_registration in
    let originate_dummy_contract ctxt script =
      let ctxt = Contract.init_origination_nonce ctxt Operation_hash.zero in
      Contract.fresh_contract_from_current_nonce ctxt
      >>=? fun (ctxt, dummy_contract) ->
      let balance =
        match Tez.of_mutez 4_000_000_000_000L with
        | Some balance ->
            balance
        | None ->
            assert false
      in
      Contract.originate
        ctxt
        dummy_contract
        ~balance
        ~delegate:None
        ~script:(script, None)
      >>=? fun ctxt -> return (ctxt, dummy_contract)
    in
    register0
      S.run_code
      (fun ctxt
           ()
           ( code,
             storage,
             parameter,
             amount,
             chain_id,
             source,
             payer,
             gas,
             entrypoint )
           ->
        let storage = Script.lazy_expr storage in
        let code = Script.lazy_expr code in
        originate_dummy_contract ctxt {storage; code}
        >>=? fun (ctxt, dummy_contract) ->
        let (source, payer) =
          match (source, payer) with
          | (Some source, Some payer) ->
              (source, payer)
          | (Some source, None) ->
              (source, source)
          | (None, Some payer) ->
              (payer, payer)
          | (None, None) ->
              (dummy_contract, dummy_contract)
        in
        let gas =
          match gas with
          | Some gas ->
              gas
          | None ->
              Constants.hard_gas_limit_per_operation ctxt
        in
        let ctxt = Gas.set_limit ctxt gas in
        let step_constants =
          let open Script_interpreter in
          {source; payer; self = dummy_contract; amount; chain_id}
        in
        Script_interpreter.execute
          ctxt
          Readable
          step_constants
          ~script:{storage; code}
          ~entrypoint
          ~parameter
        >>=? fun {Script_interpreter.storage; operations; big_map_diff; _} ->
        return (storage, operations, big_map_diff)) ;
    register0
      S.trace_code
      (fun ctxt
           ()
           ( code,
             storage,
             parameter,
             amount,
             chain_id,
             source,
             payer,
             gas,
             entrypoint )
           ->
        let storage = Script.lazy_expr storage in
        let code = Script.lazy_expr code in
        originate_dummy_contract ctxt {storage; code}
        >>=? fun (ctxt, dummy_contract) ->
        let (source, payer) =
          match (source, payer) with
          | (Some source, Some payer) ->
              (source, payer)
          | (Some source, None) ->
              (source, source)
          | (None, Some payer) ->
              (payer, payer)
          | (None, None) ->
              (dummy_contract, dummy_contract)
        in
        let gas =
          match gas with
          | Some gas ->
              gas
          | None ->
              Constants.hard_gas_limit_per_operation ctxt
        in
        let ctxt = Gas.set_limit ctxt gas in
        let step_constants =
          let open Script_interpreter in
          {source; payer; self = dummy_contract; amount; chain_id}
        in
        Script_interpreter.trace
          ctxt
          Readable
          step_constants
          ~script:{storage; code}
          ~entrypoint
          ~parameter
        >>=? fun ( {Script_interpreter.storage; operations; big_map_diff; _},
                   trace ) ->
        return (storage, operations, trace, big_map_diff)) ;
    register0 S.typecheck_code (fun ctxt () (expr, maybe_gas) ->
        let ctxt =
          match maybe_gas with
          | None ->
              Gas.set_unlimited ctxt
          | Some gas ->
              Gas.set_limit ctxt gas
        in
        Script_ir_translator.typecheck_code ctxt expr
        >>=? fun (res, ctxt) -> return (res, Gas.level ctxt)) ;
    register0 S.typecheck_data (fun ctxt () (data, ty, maybe_gas) ->
        let ctxt =
          match maybe_gas with
          | None ->
              Gas.set_unlimited ctxt
          | Some gas ->
              Gas.set_limit ctxt gas
        in
        Script_ir_translator.typecheck_data ctxt (data, ty)
        >>=? fun ctxt -> return (Gas.level ctxt)) ;
    register0 S.pack_data (fun ctxt () (expr, typ, maybe_gas) ->
        let open Script_ir_translator in
        let ctxt =
          match maybe_gas with
          | None ->
              Gas.set_unlimited ctxt
          | Some gas ->
              Gas.set_limit ctxt gas
        in
        Lwt.return (parse_packable_ty ctxt ~legacy:true (Micheline.root typ))
        >>=? fun (Ex_ty typ, ctxt) ->
        parse_data ctxt ~legacy:true typ (Micheline.root expr)
        >>=? fun (data, ctxt) ->
        Script_ir_translator.pack_data ctxt typ data
        >>=? fun (bytes, ctxt) -> return (bytes, Gas.level ctxt)) ;
    register0
      S.run_operation
      (fun ctxt
           ()
           ({shell; protocol_data = Operation_data protocol_data}, chain_id)
           ->
        (* this code is a duplicate of Apply without signature check *)
        let partial_precheck_manager_contents (type kind) ctxt
            (op : kind Kind.manager contents) : context tzresult Lwt.t =
          let (Manager_operation
                {source; fee; counter; operation; gas_limit; storage_limit}) =
            op
          in
          Lwt.return (Gas.check_limit ctxt gas_limit)
          >>=? fun () ->
          let ctxt = Gas.set_limit ctxt gas_limit in
          Lwt.return (Fees.check_storage_limit ctxt storage_limit)
          >>=? fun () ->
          Contract.must_be_allocated ctxt (Contract.implicit_contract source)
          >>=? fun () ->
          Contract.check_counter_increment ctxt source counter
          >>=? fun () ->
          ( match operation with
          | Reveal pk ->
              Contract.reveal_manager_key ctxt source pk
          | Transaction {parameters; _} ->
              (* Here the data comes already deserialized, so we need to fake the deserialization to mimic apply *)
              let arg_bytes =
                Data_encoding.Binary.to_bytes_exn
                  Script.lazy_expr_encoding
                  parameters
              in
              let arg =
                match
                  Data_encoding.Binary.of_bytes
                    Script.lazy_expr_encoding
                    arg_bytes
                with
                | Some arg ->
                    arg
                | None ->
                    assert false
              in
              (* Fail quickly if not enough gas for minimal deserialization cost *)
              Lwt.return
              @@ record_trace Apply.Gas_quota_exceeded_init_deserialize
              @@ Gas.check_enough ctxt (Script.minimal_deserialize_cost arg)
              >>=? fun () ->
              (* Fail if not enough gas for complete deserialization cost *)
              trace Apply.Gas_quota_exceeded_init_deserialize
              @@ Script.force_decode ctxt arg
              >>|? fun (_arg, ctxt) -> ctxt
          | Origination {script; _} ->
              (* Here the data comes already deserialized, so we need to fake the deserialization to mimic apply *)
              let script_bytes =
                Data_encoding.Binary.to_bytes_exn Script.encoding script
              in
              let script =
                match
                  Data_encoding.Binary.of_bytes Script.encoding script_bytes
                with
                | Some script ->
                    script
                | None ->
                    assert false
              in
              (* Fail quickly if not enough gas for minimal deserialization cost *)
              Lwt.return
              @@ record_trace Apply.Gas_quota_exceeded_init_deserialize
              @@ ( Gas.consume
                     ctxt
                     (Script.minimal_deserialize_cost script.code)
                 >>? fun ctxt ->
                 Gas.check_enough
                   ctxt
                   (Script.minimal_deserialize_cost script.storage) )
              >>=? fun () ->
              (* Fail if not enough gas for complete deserialization cost *)
              trace Apply.Gas_quota_exceeded_init_deserialize
              @@ Script.force_decode ctxt script.code
              >>=? fun (_code, ctxt) ->
              trace Apply.Gas_quota_exceeded_init_deserialize
              @@ Script.force_decode ctxt script.storage
              >>|? fun (_storage, ctxt) -> ctxt
          | _ ->
              return ctxt )
          >>=? fun ctxt ->
          Contract.get_manager_key ctxt source
          >>=? fun _public_key ->
          (* signature check unplugged from here *)
          Contract.increment_counter ctxt source
          >>=? fun ctxt ->
          Contract.spend ctxt (Contract.implicit_contract source) fee
          >>=? fun ctxt -> return ctxt
        in
        let rec partial_precheck_manager_contents_list :
            type kind.
            Alpha_context.t ->
            kind Kind.manager contents_list ->
            context tzresult Lwt.t =
         fun ctxt contents_list ->
          match contents_list with
          | Single (Manager_operation _ as op) ->
              partial_precheck_manager_contents ctxt op
          | Cons ((Manager_operation _ as op), rest) ->
              partial_precheck_manager_contents ctxt op
              >>=? fun ctxt -> partial_precheck_manager_contents_list ctxt rest
        in
        let return contents =
          return
            ( Operation_data protocol_data,
              Apply_results.Operation_metadata {contents} )
        in
        let operation : _ operation = {shell; protocol_data} in
        let hash = Operation.hash {shell; protocol_data} in
        let ctxt = Contract.init_origination_nonce ctxt hash in
        let baker = Signature.Public_key_hash.zero in
        match protocol_data.contents with
        | Single (Manager_operation _) as op ->
            partial_precheck_manager_contents_list ctxt op
            >>=? fun ctxt ->
            Apply.apply_manager_contents_list ctxt Optimized baker chain_id op
            >>= fun (_ctxt, result) -> return result
        | Cons (Manager_operation _, _) as op ->
            partial_precheck_manager_contents_list ctxt op
            >>=? fun ctxt ->
            Apply.apply_manager_contents_list ctxt Optimized baker chain_id op
            >>= fun (_ctxt, result) -> return result
        | _ ->
            Apply.apply_contents_list
              ctxt
              chain_id
              Optimized
              shell.branch
              baker
              operation
              operation.protocol_data.contents
            >>=? fun (_ctxt, result) -> return result) ;
    register0 S.entrypoint_type (fun ctxt () (expr, entrypoint) ->
        let ctxt = Gas.set_unlimited ctxt in
        let legacy = false in
        let open Script_ir_translator in
        Lwt.return
          ( parse_toplevel ~legacy expr
          >>? fun (arg_type, _, _, root_name) ->
          parse_ty
            ctxt
            ~legacy
            ~allow_big_map:true
            ~allow_operation:false
            ~allow_contract:true
            arg_type
          >>? fun (Ex_ty arg_type, _) ->
          Script_ir_translator.find_entrypoint ~root_name arg_type entrypoint
          )
        >>=? fun (_f, Ex_ty ty) ->
        unparse_ty ctxt ty
        >>=? fun (ty_node, _) -> return (Micheline.strip_locations ty_node)) ;
    register0 S.list_entrypoints (fun ctxt () expr ->
        let ctxt = Gas.set_unlimited ctxt in
        let legacy = false in
        let open Script_ir_translator in
        Lwt.return
          ( parse_toplevel ~legacy expr
          >>? fun (arg_type, _, _, root_name) ->
          parse_ty
            ctxt
            ~legacy
            ~allow_big_map:true
            ~allow_operation:false
            ~allow_contract:true
            arg_type
          >>? fun (Ex_ty arg_type, _) ->
          Script_ir_translator.list_entrypoints ~root_name arg_type ctxt )
        >>=? fun (unreachable_entrypoint, map) ->
        return
          ( unreachable_entrypoint,
            Entrypoints_map.fold
              (fun entry (_, ty) acc ->
                (entry, Micheline.strip_locations ty) :: acc)
              map
              [] ))

  let run_code ctxt block code
      (storage, input, amount, chain_id, source, payer, gas, entrypoint) =
    RPC_context.make_call0
      S.run_code
      ctxt
      block
      ()
      (code, storage, input, amount, chain_id, source, payer, gas, entrypoint)

  let trace_code ctxt block code
      (storage, input, amount, chain_id, source, payer, gas, entrypoint) =
    RPC_context.make_call0
      S.trace_code
      ctxt
      block
      ()
      (code, storage, input, amount, chain_id, source, payer, gas, entrypoint)

  let typecheck_code ctxt block =
    RPC_context.make_call0 S.typecheck_code ctxt block ()

  let typecheck_data ctxt block =
    RPC_context.make_call0 S.typecheck_data ctxt block ()

  let pack_data ctxt block = RPC_context.make_call0 S.pack_data ctxt block ()

  let run_operation ctxt block =
    RPC_context.make_call0 S.run_operation ctxt block ()

  let entrypoint_type ctxt block =
    RPC_context.make_call0 S.entrypoint_type ctxt block ()

  let list_entrypoints ctxt block =
    RPC_context.make_call0 S.list_entrypoints ctxt block ()
end

module Forge = struct
  module S = struct
    open Data_encoding

    let path = RPC_path.(path / "forge")

    let operations =
      RPC_service.post_service
        ~description:"Forge an operation"
        ~query:RPC_query.empty
        ~input:Operation.unsigned_encoding
        ~output:bytes
        RPC_path.(path / "operations")

    let empty_proof_of_work_nonce =
      MBytes.of_string
        (String.make Constants_repr.proof_of_work_nonce_size '\000')

    let protocol_data =
      RPC_service.post_service
        ~description:"Forge the protocol-specific part of a block header"
        ~query:RPC_query.empty
        ~input:
          (obj3
             (req "priority" uint16)
             (opt "nonce_hash" Nonce_hash.encoding)
             (dft
                "proof_of_work_nonce"
                (Fixed.bytes Alpha_context.Constants.proof_of_work_nonce_size)
                empty_proof_of_work_nonce))
        ~output:(obj1 (req "protocol_data" bytes))
        RPC_path.(path / "protocol_data")
  end

  let register () =
    let open Services_registration in
    register0_noctxt S.operations (fun () (shell, proto) ->
        return
          (Data_encoding.Binary.to_bytes_exn
             Operation.unsigned_encoding
             (shell, proto))) ;
    register0_noctxt
      S.protocol_data
      (fun () (priority, seed_nonce_hash, proof_of_work_nonce) ->
        return
          (Data_encoding.Binary.to_bytes_exn
             Block_header.contents_encoding
             {priority; seed_nonce_hash; proof_of_work_nonce}))

  module Manager = struct
    let operations ctxt block ~branch ~source ?sourcePubKey ~counter ~fee
        ~gas_limit ~storage_limit operations =
      Contract_services.manager_key ctxt block source
      >>= function
      | Error _ as e ->
          Lwt.return e
      | Ok revealed ->
          let ops =
            List.map
              (fun (Manager operation) ->
                Contents
                  (Manager_operation
                     {
                       source;
                       counter;
                       operation;
                       fee;
                       gas_limit;
                       storage_limit;
                     }))
              operations
          in
          let ops =
            match (sourcePubKey, revealed) with
            | (None, _) | (_, Some _) ->
                ops
            | (Some pk, None) ->
                let operation = Reveal pk in
                Contents
                  (Manager_operation
                     {
                       source;
                       counter;
                       operation;
                       fee;
                       gas_limit;
                       storage_limit;
                     })
                :: ops
          in
          RPC_context.make_call0
            S.operations
            ctxt
            block
            ()
            ({branch}, Operation.of_list ops)

    let reveal ctxt block ~branch ~source ~sourcePubKey ~counter ~fee () =
      operations
        ctxt
        block
        ~branch
        ~source
        ~sourcePubKey
        ~counter
        ~fee
        ~gas_limit:Z.zero
        ~storage_limit:Z.zero
        []

    let transaction ctxt block ~branch ~source ?sourcePubKey ~counter ~amount
        ~destination ?(entrypoint = "default") ?parameters ~gas_limit
        ~storage_limit ~fee () =
      let parameters =
        Option.unopt_map
          ~f:Script.lazy_expr
          ~default:Script.unit_parameter
          parameters
      in
      operations
        ctxt
        block
        ~branch
        ~source
        ?sourcePubKey
        ~counter
        ~fee
        ~gas_limit
        ~storage_limit
        [Manager (Transaction {amount; parameters; destination; entrypoint})]

    let origination ctxt block ~branch ~source ?sourcePubKey ~counter ~balance
        ?delegatePubKey ~script ~gas_limit ~storage_limit ~fee () =
      operations
        ctxt
        block
        ~branch
        ~source
        ?sourcePubKey
        ~counter
        ~fee
        ~gas_limit
        ~storage_limit
        [ Manager
            (Origination
               {
                 delegate = delegatePubKey;
                 script;
                 credit = balance;
                 preorigination = None;
               }) ]

    let delegation ctxt block ~branch ~source ?sourcePubKey ~counter ~fee
        delegate =
      operations
        ctxt
        block
        ~branch
        ~source
        ?sourcePubKey
        ~counter
        ~fee
        ~gas_limit:Z.zero
        ~storage_limit:Z.zero
        [Manager (Delegation delegate)]
  end

  let operation ctxt block ~branch operation =
    RPC_context.make_call0
      S.operations
      ctxt
      block
      ()
      ({branch}, Contents_list (Single operation))

  let endorsement ctxt b ~branch ~level () =
    operation ctxt b ~branch (Endorsement {level})

  let proposals ctxt b ~branch ~source ~period ~proposals () =
    operation ctxt b ~branch (Proposals {source; period; proposals})

  let ballot ctxt b ~branch ~source ~period ~proposal ~ballot () =
    operation ctxt b ~branch (Ballot {source; period; proposal; ballot})

  let seed_nonce_revelation ctxt block ~branch ~level ~nonce () =
    operation ctxt block ~branch (Seed_nonce_revelation {level; nonce})

  let double_baking_evidence ctxt block ~branch ~bh1 ~bh2 () =
    operation ctxt block ~branch (Double_baking_evidence {bh1; bh2})

  let double_endorsement_evidence ctxt block ~branch ~op1 ~op2 () =
    operation ctxt block ~branch (Double_endorsement_evidence {op1; op2})

  let empty_proof_of_work_nonce =
    MBytes.of_string
      (String.make Constants_repr.proof_of_work_nonce_size '\000')

  let protocol_data ctxt block ~priority ?seed_nonce_hash
      ?(proof_of_work_nonce = empty_proof_of_work_nonce) () =
    RPC_context.make_call0
      S.protocol_data
      ctxt
      block
      ()
      (priority, seed_nonce_hash, proof_of_work_nonce)
end

module Parse = struct
  module S = struct
    open Data_encoding

    let path = RPC_path.(path / "parse")

    let operations =
      RPC_service.post_service
        ~description:"Parse operations"
        ~query:RPC_query.empty
        ~input:
          (obj2
             (req "operations" (list (dynamic_size Operation.raw_encoding)))
             (opt "check_signature" bool))
        ~output:(list (dynamic_size Operation.encoding))
        RPC_path.(path / "operations")

    let block =
      RPC_service.post_service
        ~description:"Parse a block"
        ~query:RPC_query.empty
        ~input:Block_header.raw_encoding
        ~output:Block_header.protocol_data_encoding
        RPC_path.(path / "block")
  end

  let parse_protocol_data protocol_data =
    match
      Data_encoding.Binary.of_bytes
        Block_header.protocol_data_encoding
        protocol_data
    with
    | None ->
        failwith "Cant_parse_protocol_data"
    | Some protocol_data ->
        return protocol_data

  let register () =
    let open Services_registration in
    register0 S.operations (fun _ctxt () (operations, check) ->
        map_s
          (fun raw ->
            Lwt.return (parse_operation raw)
            >>=? fun op ->
            ( match check with
            | Some true ->
                return_unit (* FIXME *)
            (* I.check_signature ctxt *)
            (* op.protocol_data.signature op.shell op.protocol_data.contents *)
            | Some false | None ->
                return_unit )
            >>|? fun () -> op)
          operations) ;
    register0_noctxt S.block (fun () raw_block ->
        parse_protocol_data raw_block.protocol_data)

  let operations ctxt block ?check operations =
    RPC_context.make_call0 S.operations ctxt block () (operations, check)

  let block ctxt block shell protocol_data =
    RPC_context.make_call0
      S.block
      ctxt
      block
      ()
      ({shell; protocol_data} : Block_header.raw)
end

module S = struct
  open Data_encoding

  type level_query = {offset : int32}

  let level_query : level_query RPC_query.t =
    let open RPC_query in
    query (fun offset -> {offset})
    |+ field "offset" RPC_arg.int32 0l (fun t -> t.offset)
    |> seal

  let current_level =
    RPC_service.get_service
      ~description:
        "Returns the level of the interrogated block, or the one of a block \
         located `offset` blocks after in the chain (or before when \
         negative). For instance, the next block if `offset` is 1."
      ~query:level_query
      ~output:Level.encoding
      RPC_path.(path / "current_level")

  let levels_in_current_cycle =
    RPC_service.get_service
      ~description:"Levels of a cycle"
      ~query:level_query
      ~output:
        (obj2 (req "first" Raw_level.encoding) (req "last" Raw_level.encoding))
      RPC_path.(path / "levels_in_current_cycle")
end

let register () =
  Scripts.register () ;
  Forge.register () ;
  Parse.register () ;
  let open Services_registration in
  register0 S.current_level (fun ctxt q () ->
      let level = Level.current ctxt in
      return (Level.from_raw ctxt ~offset:q.offset level.level)) ;
  register0 S.levels_in_current_cycle (fun ctxt q () ->
      let levels = Level.levels_in_current_cycle ctxt ~offset:q.offset () in
      match levels with
      | [] ->
          raise Not_found
      | _ ->
          let first = List.hd (List.rev levels) in
          let last = List.hd levels in
          return (first.level, last.level))

let current_level ctxt ?(offset = 0l) block =
  RPC_context.make_call0 S.current_level ctxt block {offset} ()

let levels_in_current_cycle ctxt ?(offset = 0l) block =
  RPC_context.make_call0 S.levels_in_current_cycle ctxt block {offset} ()

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Import Alpha_context.

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Top-level evaluations are considered as an error as sources of side-effects *)
Compute
  register_error_kind
    (* ❌ Variants not supported *)
    variant "operation.cannot_parse" % string "Cannot parse operation" % string
    "The operation is ill-formed or for another protocol version" % string
    (Some
      (fun ppf =>
        fun function_parameter =>
          let 'tt := function_parameter in
          Format.fprintf ppf
            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                "The operation cannot be parsed" % string
                Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
              "The operation cannot be parsed" % string)))
    Data_encoding.__unit_value
    (fun function_parameter =>
      match function_parameter with
      |
        Tezos_protocol_environment_alpha__Environment.Error_monad.Cannot_parse_operation
        => Some tt
      | _ => None
      end)
    (fun function_parameter =>
      let 'tt := function_parameter in
      Tezos_protocol_environment_alpha__Environment.Error_monad.Cannot_parse_operation).

Definition parse_operation
  (op : Tezos_raw_protocol_alpha.Alpha_context.Operation.raw)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    Tezos_raw_protocol_alpha.Alpha_context.packed_operation :=
  match
    Data_encoding.Binary.of_bytes Operation.protocol_data_encoding
      (Tezos_raw_protocol_alpha.Alpha_context.Operation.raw.proto op) with
  | Some protocol_data =>
    ok
      {|
        Tezos_raw_protocol_alpha.Alpha_context.packed_operation.shell :=
          Tezos_raw_protocol_alpha.Alpha_context.Operation.raw.shell op;
        Tezos_raw_protocol_alpha.Alpha_context.packed_operation.protocol_data :=
          protocol_data |}
  | None =>
    __error_value
      Tezos_protocol_environment_alpha__Environment.Error_monad.Cannot_parse_operation
  end.

Definition path
  : Tezos_protocol_environment_alpha__Environment.RPC_path.path
    Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
    Tezos_protocol_environment_alpha__Environment.Updater.rpc_context :=
  op_div open_root "helpers" % string.

Module Scripts.
  Module S.
    Import Data_encoding.
    
    Definition path
      : Tezos_protocol_environment_alpha__Environment.RPC_path.path
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context :=
      op_div path "scripts" % string.
    
    Definition run_code_input_encoding
      : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
        (Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
          Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
          Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
          Tezos_raw_protocol_alpha.Alpha_context.Tez.t *
          Tezos_protocol_environment_alpha__Environment.Chain_id.t *
          option Tezos_raw_protocol_alpha.Alpha_context.Contract.t *
          option Tezos_raw_protocol_alpha.Alpha_context.Contract.t *
          option Tezos_protocol_environment_alpha__Environment.Z.t * string) :=
      obj9 (req None None "script" % string Script.expr_encoding)
        (req None None "storage" % string Script.expr_encoding)
        (req None None "input" % string Script.expr_encoding)
        (req None None "amount" % string Tez.encoding)
        (req None None "chain_id" % string Chain_id.encoding)
        (opt None None "source" % string Contract.encoding)
        (opt None None "payer" % string Contract.encoding)
        (opt None None "gas" % string z)
        (dft None None "entrypoint" % string __string_value "default" % string).
    
    Definition trace_encoding
      : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
        (list
          (Tezos_raw_protocol_alpha.Alpha_context.Script.location *
            Tezos_raw_protocol_alpha.Alpha_context.Gas.t *
            list
              (Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
                option string))) :=
      op_atat
        (let arg := def "scripted.trace" % string in
        fun eta => arg None None eta)
        (op_atat
          (let arg := __list_value in
          fun eta => arg None eta)
          (obj3 (req None None "location" % string Script.location_encoding)
            (req None None "gas" % string Gas.encoding)
            (req None None "stack" % string
              (__list_value None
                (obj2 (req None None "item" % string Script.expr_encoding)
                  (opt None None "annot" % string __string_value)))))).
    
    Definition run_code
      : Tezos_protocol_environment_alpha__Environment.RPC_service.service
        (* `POST *) unit
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context unit
        (Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
          Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
          Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
          Tezos_raw_protocol_alpha.Alpha_context.Tez.t *
          Tezos_protocol_environment_alpha__Environment.Chain_id.t *
          option Tezos_raw_protocol_alpha.Alpha_context.Contract.t *
          option Tezos_raw_protocol_alpha.Alpha_context.Contract.t *
          option Tezos_protocol_environment_alpha__Environment.Z.t * string)
        (Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
          list Tezos_raw_protocol_alpha__Alpha_context.packed_internal_operation
          * option Tezos_raw_protocol_alpha.Alpha_context.Contract.big_map_diff) :=
      RPC_service.post_service
        (Some "Run a piece of code in the current context" % string)
        RPC_query.empty run_code_input_encoding
        (obj3 (req None None "storage" % string Script.expr_encoding)
          (req None None "operations" % string
            (__list_value None Operation.internal_operation_encoding))
          (opt None None "big_map_diff" % string Contract.big_map_diff_encoding))
        (op_div path "run_code" % string).
    
    Definition trace_code
      : Tezos_protocol_environment_alpha__Environment.RPC_service.service
        (* `POST *) unit
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context unit
        (Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
          Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
          Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
          Tezos_raw_protocol_alpha.Alpha_context.Tez.t *
          Tezos_protocol_environment_alpha__Environment.Chain_id.t *
          option Tezos_raw_protocol_alpha.Alpha_context.Contract.t *
          option Tezos_raw_protocol_alpha.Alpha_context.Contract.t *
          option Tezos_protocol_environment_alpha__Environment.Z.t * string)
        (Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
          list Tezos_raw_protocol_alpha__Alpha_context.packed_internal_operation
          *
          list
            (Tezos_raw_protocol_alpha.Alpha_context.Script.location *
              Tezos_raw_protocol_alpha.Alpha_context.Gas.t *
              list
                (Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
                  option string)) *
          option Tezos_raw_protocol_alpha.Alpha_context.Contract.big_map_diff) :=
      RPC_service.post_service
        (Some
          "Run a piece of code in the current context, keeping a trace" % string)
        RPC_query.empty run_code_input_encoding
        (obj4 (req None None "storage" % string Script.expr_encoding)
          (req None None "operations" % string
            (__list_value None Operation.internal_operation_encoding))
          (req None None "trace" % string trace_encoding)
          (opt None None "big_map_diff" % string Contract.big_map_diff_encoding))
        (op_div path "trace_code" % string).
    
    Definition typecheck_code
      : Tezos_protocol_environment_alpha__Environment.RPC_service.service
        (* `POST *) unit
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context unit
        (Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
          option Tezos_protocol_environment_alpha__Environment.Z.t)
        (list
          (Tezos_raw_protocol_alpha.Alpha_context.Script.location *
            (list
              (Tezos_raw_protocol_alpha.Alpha_context.Script.expr * list string)
              *
              list
                (Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
                  list string))) * Tezos_raw_protocol_alpha.Alpha_context.Gas.t) :=
      RPC_service.post_service
        (Some "Typecheck a piece of code in the current context" % string)
        RPC_query.empty
        (obj2 (req None None "program" % string Script.expr_encoding)
          (opt None None "gas" % string z))
        (obj2
          (req None None "type_map" % string
            Script_tc_errors_registration.type_map_enc)
          (req None None "gas" % string Gas.encoding))
        (op_div path "typecheck_code" % string).
    
    Definition typecheck_data
      : Tezos_protocol_environment_alpha__Environment.RPC_service.service
        (* `POST *) unit
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context unit
        (Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
          Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
          option Tezos_protocol_environment_alpha__Environment.Z.t)
        Tezos_raw_protocol_alpha.Alpha_context.Gas.t :=
      RPC_service.post_service
        (Some
          "Check that some data expression is well formed and of a given type in the current context"
            % string) RPC_query.empty
        (obj3 (req None None "data" % string Script.expr_encoding)
          (req None None "type" % string Script.expr_encoding)
          (opt None None "gas" % string z))
        (obj1 (req None None "gas" % string Gas.encoding))
        (op_div path "typecheck_data" % string).
    
    Definition pack_data
      : Tezos_protocol_environment_alpha__Environment.RPC_service.service
        (* `POST *) unit
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context unit
        (Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
          Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
          option Tezos_protocol_environment_alpha__Environment.Z.t)
        (Tezos_protocol_environment_alpha__Environment.MBytes.t *
          Tezos_raw_protocol_alpha.Alpha_context.Gas.t) :=
      RPC_service.post_service
        (Some
          "Computes the serialized version of some data expression using the same algorithm as script instruction PACK"
            % string) RPC_query.empty
        (obj3 (req None None "data" % string Script.expr_encoding)
          (req None None "type" % string Script.expr_encoding)
          (opt None None "gas" % string z))
        (obj2 (req None None "packed" % string __bytes_value)
          (req None None "gas" % string Gas.encoding))
        (op_div path "pack_data" % string).
    
    Definition run_operation
      : Tezos_protocol_environment_alpha__Environment.RPC_service.service
        (* `POST *) unit
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context unit
        (Tezos_raw_protocol_alpha.Alpha_context.Operation.packed *
          Tezos_protocol_environment_alpha__Environment.Chain_id.t)
        (Tezos_raw_protocol_alpha.Alpha_context.Operation.packed_protocol_data *
          Tezos_raw_protocol_alpha.Apply_results.packed_operation_metadata) :=
      RPC_service.post_service
        (Some "Run an operation without signature checks" % string)
        RPC_query.empty
        (obj2 (req None None "operation" % string Operation.encoding)
          (req None None "chain_id" % string Chain_id.encoding))
        Apply_results.operation_data_and_metadata_encoding
        (op_div path "run_operation" % string).
    
    Definition entrypoint_type
      : Tezos_protocol_environment_alpha__Environment.RPC_service.service
        (* `POST *) unit
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context unit
        (Tezos_raw_protocol_alpha.Alpha_context.Script.expr * string)
        Tezos_raw_protocol_alpha.Alpha_context.Script.expr :=
      RPC_service.post_service
        (Some "Return the type of the given entrypoint" % string)
        RPC_query.empty
        (obj2 (req None None "script" % string Script.expr_encoding)
          (dft None None "entrypoint" % string __string_value "default" % string))
        (obj1 (req None None "entrypoint_type" % string Script.expr_encoding))
        (op_div path "entrypoint" % string).
    
    Definition list_entrypoints
      : Tezos_protocol_environment_alpha__Environment.RPC_service.service
        (* `POST *) unit
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context unit
        Tezos_raw_protocol_alpha.Alpha_context.Script.expr
        (list (list Tezos_raw_protocol_alpha.Michelson_v1_primitives.prim) *
          list (string * Tezos_raw_protocol_alpha.Alpha_context.Script.expr)) :=
      RPC_service.post_service
        (Some "Return the list of entrypoints of the given script" % string)
        RPC_query.empty
        (obj1 (req None None "script" % string Script.expr_encoding))
        (obj2
          (dft None None "unreachable" % string
            (Data_encoding.__list_value None
              (obj1
                (req None None "path" % string
                  (Data_encoding.__list_value None
                    Michelson_v1_primitives.prim_encoding)))) [])
          (req None None "entrypoints" % string (assoc Script.expr_encoding)))
        (op_div path "entrypoints" % string).
  End S.
  
  Definition register (function_parameter : unit) : unit :=
    let 'tt := function_parameter in
    let originate_dummy_contract
      (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context) (script :
      Tezos_raw_protocol_alpha__Alpha_context.Script.t)
      : Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_raw_protocol_alpha__Alpha_context.context *
            Tezos_raw_protocol_alpha.Alpha_context.Contract.t)) :=
      let ctxt := Contract.init_origination_nonce ctxt Operation_hash.zero in
      op_gtgteqquestion (Contract.fresh_contract_from_current_nonce ctxt)
        (fun function_parameter =>
          let '(ctxt, dummy_contract) := function_parameter in
          let balance :=
            match
              Tez.of_mutez
                (* ❌ Constant of type int64 is converted to int *)
                4000000000000 with
            | Some balance => balance
            | None =>
              (* ❌ Assert instruction is not handled. *)
              assert false
            end in
          op_gtgteqquestion
            (Contract.originate ctxt dummy_contract balance (script, None) None)
            (fun ctxt => __return (ctxt, dummy_contract))) in
    (* ❌ Sequences of instructions are not handled (operator ";") *)
    let _ :=
      register0 S.run_code
        (fun ctxt =>
          fun function_parameter =>
            let 'tt := function_parameter in
            fun function_parameter =>
              let
                '(code, storage, parameter, amount, chain_id, source, payer,
                  gas, entrypoint) := function_parameter in
              let storage := Script.lazy_expr storage in
              let code := Script.lazy_expr code in
              op_gtgteqquestion
                (originate_dummy_contract ctxt
                  {|
                    Tezos_raw_protocol_alpha__Alpha_context.Script.t.code :=
                      code;
                    Tezos_raw_protocol_alpha__Alpha_context.Script.t.storage :=
                      storage |})
                (fun function_parameter =>
                  let '(ctxt, dummy_contract) := function_parameter in
                  let '(source, payer) :=
                    match (source, payer) with
                    | (Some source, Some payer) => (source, payer)
                    | (Some source, None) => (source, source)
                    | (None, Some payer) => (payer, payer)
                    | (None, None) => (dummy_contract, dummy_contract)
                    end in
                  let gas :=
                    match gas with
                    | Some gas => gas
                    | None => Constants.hard_gas_limit_per_operation ctxt
                    end in
                  let ctxt := Gas.set_limit ctxt gas in
                  let step_constants :=
                    {|
                      Tezos_raw_protocol_alpha.Script_interpreter.step_constants.source :=
                        source;
                      Tezos_raw_protocol_alpha.Script_interpreter.step_constants.payer :=
                        payer;
                      Tezos_raw_protocol_alpha.Script_interpreter.step_constants.self :=
                        dummy_contract;
                      Tezos_raw_protocol_alpha.Script_interpreter.step_constants.amount :=
                        amount;
                      Tezos_raw_protocol_alpha.Script_interpreter.step_constants.chain_id :=
                        chain_id |} in
                  op_gtgteqquestion
                    (Script_interpreter.execute ctxt
                      Tezos_raw_protocol_alpha.Script_ir_translator.Readable
                      step_constants
                      {|
                        Tezos_raw_protocol_alpha.Alpha_context.Script.t.code :=
                          code;
                        Tezos_raw_protocol_alpha.Alpha_context.Script.t.storage :=
                          storage |} entrypoint parameter)
                    (fun function_parameter =>
                      let '{|
                        Tezos_raw_protocol_alpha.Script_interpreter.execution_result.storage :=
                          storage;
                          Tezos_raw_protocol_alpha.Script_interpreter.execution_result.big_map_diff
                            := big_map_diff;
                          Tezos_raw_protocol_alpha.Script_interpreter.execution_result.operations
                            := operations
                          |} := function_parameter in
                      __return (storage, operations, big_map_diff)))) in
    (* ❌ Sequences of instructions are not handled (operator ";") *)
    let _ :=
      register0 S.trace_code
        (fun ctxt =>
          fun function_parameter =>
            let 'tt := function_parameter in
            fun function_parameter =>
              let
                '(code, storage, parameter, amount, chain_id, source, payer,
                  gas, entrypoint) := function_parameter in
              let storage := Script.lazy_expr storage in
              let code := Script.lazy_expr code in
              op_gtgteqquestion
                (originate_dummy_contract ctxt
                  {|
                    Tezos_raw_protocol_alpha__Alpha_context.Script.t.code :=
                      code;
                    Tezos_raw_protocol_alpha__Alpha_context.Script.t.storage :=
                      storage |})
                (fun function_parameter =>
                  let '(ctxt, dummy_contract) := function_parameter in
                  let '(source, payer) :=
                    match (source, payer) with
                    | (Some source, Some payer) => (source, payer)
                    | (Some source, None) => (source, source)
                    | (None, Some payer) => (payer, payer)
                    | (None, None) => (dummy_contract, dummy_contract)
                    end in
                  let gas :=
                    match gas with
                    | Some gas => gas
                    | None => Constants.hard_gas_limit_per_operation ctxt
                    end in
                  let ctxt := Gas.set_limit ctxt gas in
                  let step_constants :=
                    {|
                      Tezos_raw_protocol_alpha.Script_interpreter.step_constants.source :=
                        source;
                      Tezos_raw_protocol_alpha.Script_interpreter.step_constants.payer :=
                        payer;
                      Tezos_raw_protocol_alpha.Script_interpreter.step_constants.self :=
                        dummy_contract;
                      Tezos_raw_protocol_alpha.Script_interpreter.step_constants.amount :=
                        amount;
                      Tezos_raw_protocol_alpha.Script_interpreter.step_constants.chain_id :=
                        chain_id |} in
                  op_gtgteqquestion
                    (Script_interpreter.trace ctxt
                      Tezos_raw_protocol_alpha.Script_ir_translator.Readable
                      step_constants
                      {|
                        Tezos_raw_protocol_alpha.Alpha_context.Script.t.code :=
                          code;
                        Tezos_raw_protocol_alpha.Alpha_context.Script.t.storage :=
                          storage |} entrypoint parameter)
                    (fun function_parameter =>
                      let
                        '({|
                          Tezos_raw_protocol_alpha.Script_interpreter.execution_result.storage :=
                            storage;
                            Tezos_raw_protocol_alpha.Script_interpreter.execution_result.big_map_diff
                              := big_map_diff;
                            Tezos_raw_protocol_alpha.Script_interpreter.execution_result.operations
                              := operations
                            |}, trace) := function_parameter in
                      __return (storage, operations, trace, big_map_diff)))) in
    (* ❌ Sequences of instructions are not handled (operator ";") *)
    let _ :=
      register0 S.typecheck_code
        (fun ctxt =>
          fun function_parameter =>
            let 'tt := function_parameter in
            fun function_parameter =>
              let '(expr, maybe_gas) := function_parameter in
              let ctxt :=
                match maybe_gas with
                | None => Gas.set_unlimited ctxt
                | Some gas => Gas.set_limit ctxt gas
                end in
              op_gtgteqquestion (Script_ir_translator.typecheck_code ctxt expr)
                (fun function_parameter =>
                  let '(res, ctxt) := function_parameter in
                  __return (res, (Gas.level ctxt)))) in
    (* ❌ Sequences of instructions are not handled (operator ";") *)
    let _ :=
      register0 S.typecheck_data
        (fun ctxt =>
          fun function_parameter =>
            let 'tt := function_parameter in
            fun function_parameter =>
              let '(data, ty, maybe_gas) := function_parameter in
              let ctxt :=
                match maybe_gas with
                | None => Gas.set_unlimited ctxt
                | Some gas => Gas.set_limit ctxt gas
                end in
              op_gtgteqquestion
                (Script_ir_translator.typecheck_data None ctxt (data, ty))
                (fun ctxt => __return (Gas.level ctxt))) in
    (* ❌ Sequences of instructions are not handled (operator ";") *)
    let _ :=
      register0 S.pack_data
        (fun ctxt =>
          fun function_parameter =>
            let 'tt := function_parameter in
            fun function_parameter =>
              let '(expr, typ, maybe_gas) := function_parameter in
              let ctxt :=
                match maybe_gas with
                | None => Gas.set_unlimited ctxt
                | Some gas => Gas.set_limit ctxt gas
                end in
              op_gtgteqquestion
                (Lwt.__return (parse_packable_ty ctxt true (Micheline.root typ)))
                (fun function_parameter =>
                  let
                    '(Tezos_raw_protocol_alpha.Script_ir_translator.Ex_ty typ,
                      ctxt) := function_parameter in
                  op_gtgteqquestion
                    (parse_data None ctxt true typ (Micheline.root expr))
                    (fun function_parameter =>
                      let '(data, ctxt) := function_parameter in
                      op_gtgteqquestion
                        (Script_ir_translator.pack_data ctxt typ data)
                        (fun function_parameter =>
                          let '(__bytes_value, ctxt) := function_parameter in
                          __return (__bytes_value, (Gas.level ctxt)))))) in
    (* ❌ Sequences of instructions are not handled (operator ";") *)
    let _ :=
      register0 S.run_operation
        (fun ctxt =>
          fun function_parameter =>
            let 'tt := function_parameter in
            fun function_parameter =>
              let
                '({|
                  Tezos_raw_protocol_alpha.Alpha_context.packed_operation.shell := shell;
                    Tezos_raw_protocol_alpha.Alpha_context.packed_operation.protocol_data
                      :=
                      Tezos_raw_protocol_alpha.Alpha_context.Operation_data
                        protocol_data
                    |}, chain_id) := function_parameter in
              let partial_precheck_manager_contents {A : Set}
                (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context) (op :
                Tezos_raw_protocol_alpha.Alpha_context.contents
                  (Tezos_raw_protocol_alpha.Alpha_context.Kind.manager A))
                : Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
                    Tezos_raw_protocol_alpha.Alpha_context.context) :=
                let
                  'Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
                    Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.source :=
                      source;
                      Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.fee
                        := fee;
                      Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.counter
                        := counter;
                      Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.operation
                        := operation;
                      Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.gas_limit
                        := gas_limit;
                      Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.storage_limit
                        := storage_limit
                      |} := op in
                op_gtgteqquestion
                  (Lwt.__return (Gas.check_limit ctxt gas_limit))
                  (fun function_parameter =>
                    let 'tt := function_parameter in
                    let ctxt := Gas.set_limit ctxt gas_limit in
                    op_gtgteqquestion
                      (Lwt.__return
                        (Fees.check_storage_limit ctxt storage_limit))
                      (fun function_parameter =>
                        let 'tt := function_parameter in
                        op_gtgteqquestion
                          (Contract.must_be_allocated ctxt
                            (Contract.implicit_contract source))
                          (fun function_parameter =>
                            let 'tt := function_parameter in
                            op_gtgteqquestion
                              (Contract.check_counter_increment ctxt source
                                counter)
                              (fun function_parameter =>
                                let 'tt := function_parameter in
                                op_gtgteqquestion
                                  match operation with
                                  |
                                    Tezos_raw_protocol_alpha.Alpha_context.Reveal
                                      pk =>
                                    Contract.reveal_manager_key ctxt source pk
                                  |
                                    Tezos_raw_protocol_alpha.Alpha_context.Transaction
                                      {|
                                      Tezos_raw_protocol_alpha.Alpha_context.manager_operation.Transaction.parameters
                                        := parameters
                                        |} =>
                                    let arg_bytes :=
                                      Data_encoding.Binary.to_bytes_exn
                                        Script.lazy_expr_encoding parameters in
                                    let arg :=
                                      match
                                        Data_encoding.Binary.of_bytes
                                          Script.lazy_expr_encoding arg_bytes
                                        with
                                      | Some arg => arg
                                      | None =>
                                        (* ❌ Assert instruction is not handled. *)
                                        assert false
                                      end in
                                    op_gtgteqquestion
                                      (op_atat Lwt.__return
                                        (op_atat
                                          (record_trace
                                            Tezos_protocol_environment_alpha__Environment.Error_monad.Gas_quota_exceeded_init_deserialize)
                                          (Gas.check_enough ctxt
                                            (Script.minimal_deserialize_cost arg))))
                                      (fun function_parameter =>
                                        let 'tt := function_parameter in
                                        op_gtgtpipequestion
                                          (op_atat
                                            (trace
                                              Tezos_protocol_environment_alpha__Environment.Error_monad.Gas_quota_exceeded_init_deserialize)
                                            (Script.force_decode ctxt arg))
                                          (fun function_parameter =>
                                            let '(_arg, ctxt) :=
                                              function_parameter in
                                            ctxt))
                                  |
                                    Tezos_raw_protocol_alpha.Alpha_context.Origination
                                      {|
                                      Tezos_raw_protocol_alpha.Alpha_context.manager_operation.Origination.script :=
                                        script
                                        |} =>
                                    let script_bytes :=
                                      Data_encoding.Binary.to_bytes_exn
                                        Script.encoding script in
                                    let script :=
                                      match
                                        Data_encoding.Binary.of_bytes
                                          Script.encoding script_bytes with
                                      | Some script => script
                                      | None =>
                                        (* ❌ Assert instruction is not handled. *)
                                        assert false
                                      end in
                                    op_gtgteqquestion
                                      (op_atat Lwt.__return
                                        (op_atat
                                          (record_trace
                                            Tezos_protocol_environment_alpha__Environment.Error_monad.Gas_quota_exceeded_init_deserialize)
                                          (op_gtgtquestion
                                            (Gas.consume ctxt
                                              (Script.minimal_deserialize_cost
                                                (Tezos_raw_protocol_alpha.Alpha_context.Script.t.code
                                                  script)))
                                            (fun ctxt =>
                                              Gas.check_enough ctxt
                                                (Script.minimal_deserialize_cost
                                                  (Tezos_raw_protocol_alpha.Alpha_context.Script.t.storage
                                                    script))))))
                                      (fun function_parameter =>
                                        let 'tt := function_parameter in
                                        op_gtgteqquestion
                                          (op_atat
                                            (trace
                                              Tezos_protocol_environment_alpha__Environment.Error_monad.Gas_quota_exceeded_init_deserialize)
                                            (Script.force_decode ctxt
                                              (Tezos_raw_protocol_alpha.Alpha_context.Script.t.code
                                                script)))
                                          (fun function_parameter =>
                                            let '(_code, ctxt) :=
                                              function_parameter in
                                            op_gtgtpipequestion
                                              (op_atat
                                                (trace
                                                  Tezos_protocol_environment_alpha__Environment.Error_monad.Gas_quota_exceeded_init_deserialize)
                                                (Script.force_decode ctxt
                                                  (Tezos_raw_protocol_alpha.Alpha_context.Script.t.storage
                                                    script)))
                                              (fun function_parameter =>
                                                let '(_storage, ctxt) :=
                                                  function_parameter in
                                                ctxt)))
                                  | _ => __return ctxt
                                  end
                                  (fun ctxt =>
                                    op_gtgteqquestion
                                      (Contract.get_manager_key ctxt source)
                                      (fun _public_key =>
                                        op_gtgteqquestion
                                          (Contract.increment_counter ctxt
                                            source)
                                          (fun ctxt =>
                                            op_gtgteqquestion
                                              (Contract.spend ctxt
                                                (Contract.implicit_contract
                                                  source) fee)
                                              (fun ctxt => __return ctxt))))))))
                in
              let fix partial_precheck_manager_contents_list {kind : Set}
                (ctxt : Tezos_raw_protocol_alpha.Alpha_context.t) (contents_list
                :
                Tezos_raw_protocol_alpha.Alpha_context.contents_list
                  (Tezos_raw_protocol_alpha.Alpha_context.Kind.manager kind))
                : Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
                    Tezos_raw_protocol_alpha.Alpha_context.context) :=
                match contents_list with
                |
                  Tezos_raw_protocol_alpha.Alpha_context.Single
                    ((Tezos_raw_protocol_alpha.Alpha_context.Manager_operation _)
                      as op) => partial_precheck_manager_contents ctxt op
                |
                  Tezos_raw_protocol_alpha.Alpha_context.Cons
                    ((Tezos_raw_protocol_alpha.Alpha_context.Manager_operation _)
                      as op) rest =>
                  op_gtgteqquestion (partial_precheck_manager_contents ctxt op)
                    (fun ctxt =>
                      partial_precheck_manager_contents_list ctxt rest)
                end in
              let __return {A : Set}
                (contents :
                Tezos_raw_protocol_alpha.Apply_results.contents_result_list A)
                : Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
                    (Tezos_raw_protocol_alpha.Alpha_context.packed_protocol_data
                      *
                      Tezos_raw_protocol_alpha.Apply_results.packed_operation_metadata)) :=
                __return
                  ((Tezos_raw_protocol_alpha.Alpha_context.Operation_data
                    protocol_data),
                    (Tezos_raw_protocol_alpha.Apply_results.Operation_metadata
                      {|
                        Tezos_raw_protocol_alpha.Apply_results.operation_metadata.contents :=
                          contents |})) in
              let operation :=
                {|
                  Tezos_raw_protocol_alpha.Alpha_context.operation.shell :=
                    shell;
                  Tezos_raw_protocol_alpha.Alpha_context.operation.protocol_data :=
                    protocol_data |} in
              let __hash_value :=
                Operation.__hash_value
                  {|
                    Tezos_raw_protocol_alpha.Alpha_context.operation.shell :=
                      shell;
                    Tezos_raw_protocol_alpha.Alpha_context.operation.protocol_data :=
                      protocol_data |} in
              let ctxt := Contract.init_origination_nonce ctxt __hash_value in
              let baker := Signature.Public_key_hash.zero in
              match
                Tezos_raw_protocol_alpha.Alpha_context.protocol_data.contents
                  protocol_data with
              |
                (Tezos_raw_protocol_alpha.Alpha_context.Single
                  (Tezos_raw_protocol_alpha.Alpha_context.Manager_operation _))
                  as op =>
                op_gtgteqquestion
                  (partial_precheck_manager_contents_list ctxt op)
                  (fun ctxt =>
                    op_gtgteq
                      (Apply.apply_manager_contents_list ctxt
                        Tezos_raw_protocol_alpha.Script_ir_translator.Optimized
                        baker chain_id op)
                      (fun function_parameter =>
                        let '(_ctxt, __result_value) := function_parameter in
                        __return __result_value))
              |
                (Tezos_raw_protocol_alpha.Alpha_context.Cons
                  (Tezos_raw_protocol_alpha.Alpha_context.Manager_operation _) _)
                  as op =>
                op_gtgteqquestion
                  (partial_precheck_manager_contents_list ctxt op)
                  (fun ctxt =>
                    op_gtgteq
                      (Apply.apply_manager_contents_list ctxt
                        Tezos_raw_protocol_alpha.Script_ir_translator.Optimized
                        baker chain_id op)
                      (fun function_parameter =>
                        let '(_ctxt, __result_value) := function_parameter in
                        __return __result_value))
              | _ =>
                op_gtgteqquestion
                  (Apply.apply_contents_list ctxt chain_id
                    Tezos_raw_protocol_alpha.Script_ir_translator.Optimized
                    (Tezos_protocol_environment_alpha__Environment.Operation.shell_header.branch
                      shell) baker operation
                    (Tezos_raw_protocol_alpha.Alpha_context.protocol_data.contents
                      (Tezos_raw_protocol_alpha.Alpha_context.operation.protocol_data
                        operation)))
                  (fun function_parameter =>
                    let '(_ctxt, __result_value) := function_parameter in
                    __return __result_value)
              end) in
    (* ❌ Sequences of instructions are not handled (operator ";") *)
    let _ :=
      register0 S.entrypoint_type
        (fun ctxt =>
          fun function_parameter =>
            let 'tt := function_parameter in
            fun function_parameter =>
              let '(expr, entrypoint) := function_parameter in
              let ctxt := Gas.set_unlimited ctxt in
              let legacy := false in
              op_gtgteqquestion
                (Lwt.__return
                  (op_gtgtquestion (parse_toplevel legacy expr)
                    (fun function_parameter =>
                      let '(arg_type, _, _, root_name) := function_parameter in
                      op_gtgtquestion
                        (parse_ty ctxt legacy true false true arg_type)
                        (fun function_parameter =>
                          let
                            '(Tezos_raw_protocol_alpha.Script_ir_translator.Ex_ty
                              arg_type, _) := function_parameter in
                          Script_ir_translator.find_entrypoint arg_type
                            root_name entrypoint))))
                (fun function_parameter =>
                  let
                    '(_f, Tezos_raw_protocol_alpha.Script_ir_translator.Ex_ty ty) :=
                    function_parameter in
                  op_gtgteqquestion (unparse_ty ctxt ty)
                    (fun function_parameter =>
                      let '(ty_node, _) := function_parameter in
                      __return (Micheline.strip_locations ty_node)))) in
    register0 S.list_entrypoints
      (fun ctxt =>
        fun function_parameter =>
          let 'tt := function_parameter in
          fun expr =>
            let ctxt := Gas.set_unlimited ctxt in
            let legacy := false in
            op_gtgteqquestion
              (Lwt.__return
                (op_gtgtquestion (parse_toplevel legacy expr)
                  (fun function_parameter =>
                    let '(arg_type, _, _, root_name) := function_parameter in
                    op_gtgtquestion
                      (parse_ty ctxt legacy true false true arg_type)
                      (fun function_parameter =>
                        let
                          '(Tezos_raw_protocol_alpha.Script_ir_translator.Ex_ty
                            arg_type, _) := function_parameter in
                        Script_ir_translator.list_entrypoints arg_type ctxt
                          root_name))))
              (fun function_parameter =>
                let '(unreachable_entrypoint, map) := function_parameter in
                __return
                  (unreachable_entrypoint,
                    (Entrypoints_map.fold
                      (fun entry =>
                        fun function_parameter =>
                          let '(_, ty) := function_parameter in
                          fun acc =>
                            cons (entry, (Micheline.strip_locations ty)) acc)
                      map [])))).
  
  Definition run_code {D E G I K L a b c i o q : Set}
    (ctxt :
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
          (* `POST *) unit + (* `PUT *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
      D -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (E * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
            (* `POST *) unit + (* `PUT *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i
          o -> D -> a -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (G * a * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
              (* `POST *) unit + (* `PUT *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
              b) q i o -> D -> a -> b -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (I * a * b * q * i * o)) *
            (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
              ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
                (* `POST *) unit + (* `PUT *) unit)
              Tezos_protocol_environment_alpha__Environment.RPC_context.t
              (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
                * b) * c) q i o -> D -> a -> b -> c -> q -> i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (K * a * b * c * q * i * o)) * L)))) * L * D) (block : D)
    (code : Tezos_raw_protocol_alpha.Alpha_context.Script.expr)
    (function_parameter :
      Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
        Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
        Tezos_raw_protocol_alpha.Alpha_context.Tez.t *
        Tezos_protocol_environment_alpha__Environment.Chain_id.t *
        option Tezos_raw_protocol_alpha.Alpha_context.Contract.t *
        option Tezos_raw_protocol_alpha.Alpha_context.Contract.t *
        option Tezos_protocol_environment_alpha__Environment.Z.t * string)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        (Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
          list Tezos_raw_protocol_alpha__Alpha_context.packed_internal_operation
          * option Tezos_raw_protocol_alpha.Alpha_context.Contract.big_map_diff)) :=
    let '(storage, input, amount, chain_id, source, payer, gas, entrypoint) :=
      function_parameter in
    RPC_context.make_call0 S.run_code ctxt block tt
      (code, storage, input, amount, chain_id, source, payer, gas, entrypoint).
  
  Definition trace_code {D E G I K L a b c i o q : Set}
    (ctxt :
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
          (* `POST *) unit + (* `PUT *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
      D -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (E * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
            (* `POST *) unit + (* `PUT *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i
          o -> D -> a -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (G * a * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
              (* `POST *) unit + (* `PUT *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
              b) q i o -> D -> a -> b -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (I * a * b * q * i * o)) *
            (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
              ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
                (* `POST *) unit + (* `PUT *) unit)
              Tezos_protocol_environment_alpha__Environment.RPC_context.t
              (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
                * b) * c) q i o -> D -> a -> b -> c -> q -> i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (K * a * b * c * q * i * o)) * L)))) * L * D) (block : D)
    (code : Tezos_raw_protocol_alpha.Alpha_context.Script.expr)
    (function_parameter :
      Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
        Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
        Tezos_raw_protocol_alpha.Alpha_context.Tez.t *
        Tezos_protocol_environment_alpha__Environment.Chain_id.t *
        option Tezos_raw_protocol_alpha.Alpha_context.Contract.t *
        option Tezos_raw_protocol_alpha.Alpha_context.Contract.t *
        option Tezos_protocol_environment_alpha__Environment.Z.t * string)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        (Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
          list Tezos_raw_protocol_alpha__Alpha_context.packed_internal_operation
          *
          list
            (Tezos_raw_protocol_alpha.Alpha_context.Script.location *
              Tezos_raw_protocol_alpha.Alpha_context.Gas.t *
              list
                (Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
                  option string)) *
          option Tezos_raw_protocol_alpha.Alpha_context.Contract.big_map_diff)) :=
    let '(storage, input, amount, chain_id, source, payer, gas, entrypoint) :=
      function_parameter in
    RPC_context.make_call0 S.trace_code ctxt block tt
      (code, storage, input, amount, chain_id, source, payer, gas, entrypoint).
  
  Definition typecheck_code {D E G I K L a b c i o q : Set}
    (ctxt :
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
          (* `POST *) unit + (* `PUT *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
      D -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (E * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
            (* `POST *) unit + (* `PUT *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i
          o -> D -> a -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (G * a * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
              (* `POST *) unit + (* `PUT *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
              b) q i o -> D -> a -> b -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (I * a * b * q * i * o)) *
            (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
              ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
                (* `POST *) unit + (* `PUT *) unit)
              Tezos_protocol_environment_alpha__Environment.RPC_context.t
              (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
                * b) * c) q i o -> D -> a -> b -> c -> q -> i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (K * a * b * c * q * i * o)) * L)))) * L * D) (block : D)
    : Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
      option Tezos_protocol_environment_alpha__Environment.Z.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        (list
          (Tezos_raw_protocol_alpha.Alpha_context.Script.location *
            (list
              (Tezos_raw_protocol_alpha.Alpha_context.Script.expr * list string)
              *
              list
                (Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
                  list string))) * Tezos_raw_protocol_alpha.Alpha_context.Gas.t)) :=
    RPC_context.make_call0 S.typecheck_code ctxt block tt.
  
  Definition typecheck_data {D E G I K L a b c i o q : Set}
    (ctxt :
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
          (* `POST *) unit + (* `PUT *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
      D -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (E * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
            (* `POST *) unit + (* `PUT *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i
          o -> D -> a -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (G * a * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
              (* `POST *) unit + (* `PUT *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
              b) q i o -> D -> a -> b -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (I * a * b * q * i * o)) *
            (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
              ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
                (* `POST *) unit + (* `PUT *) unit)
              Tezos_protocol_environment_alpha__Environment.RPC_context.t
              (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
                * b) * c) q i o -> D -> a -> b -> c -> q -> i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (K * a * b * c * q * i * o)) * L)))) * L * D) (block : D)
    : Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
      Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
      option Tezos_protocol_environment_alpha__Environment.Z.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        Tezos_raw_protocol_alpha.Alpha_context.Gas.t) :=
    RPC_context.make_call0 S.typecheck_data ctxt block tt.
  
  Definition pack_data {D E G I K L a b c i o q : Set}
    (ctxt :
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
          (* `POST *) unit + (* `PUT *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
      D -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (E * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
            (* `POST *) unit + (* `PUT *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i
          o -> D -> a -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (G * a * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
              (* `POST *) unit + (* `PUT *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
              b) q i o -> D -> a -> b -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (I * a * b * q * i * o)) *
            (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
              ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
                (* `POST *) unit + (* `PUT *) unit)
              Tezos_protocol_environment_alpha__Environment.RPC_context.t
              (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
                * b) * c) q i o -> D -> a -> b -> c -> q -> i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (K * a * b * c * q * i * o)) * L)))) * L * D) (block : D)
    : Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
      Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
      option Tezos_protocol_environment_alpha__Environment.Z.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        (Tezos_protocol_environment_alpha__Environment.MBytes.t *
          Tezos_raw_protocol_alpha.Alpha_context.Gas.t)) :=
    RPC_context.make_call0 S.pack_data ctxt block tt.
  
  Definition run_operation {D E G I K L a b c i o q : Set}
    (ctxt :
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
          (* `POST *) unit + (* `PUT *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
      D -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (E * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
            (* `POST *) unit + (* `PUT *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i
          o -> D -> a -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (G * a * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
              (* `POST *) unit + (* `PUT *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
              b) q i o -> D -> a -> b -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (I * a * b * q * i * o)) *
            (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
              ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
                (* `POST *) unit + (* `PUT *) unit)
              Tezos_protocol_environment_alpha__Environment.RPC_context.t
              (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
                * b) * c) q i o -> D -> a -> b -> c -> q -> i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (K * a * b * c * q * i * o)) * L)))) * L * D) (block : D)
    : Tezos_raw_protocol_alpha.Alpha_context.Operation.packed *
      Tezos_protocol_environment_alpha__Environment.Chain_id.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        (Tezos_raw_protocol_alpha.Alpha_context.Operation.packed_protocol_data *
          Tezos_raw_protocol_alpha.Apply_results.packed_operation_metadata)) :=
    RPC_context.make_call0 S.run_operation ctxt block tt.
  
  Definition entrypoint_type {D E G I K L a b c i o q : Set}
    (ctxt :
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
          (* `POST *) unit + (* `PUT *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
      D -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (E * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
            (* `POST *) unit + (* `PUT *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i
          o -> D -> a -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (G * a * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
              (* `POST *) unit + (* `PUT *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
              b) q i o -> D -> a -> b -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (I * a * b * q * i * o)) *
            (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
              ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
                (* `POST *) unit + (* `PUT *) unit)
              Tezos_protocol_environment_alpha__Environment.RPC_context.t
              (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
                * b) * c) q i o -> D -> a -> b -> c -> q -> i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (K * a * b * c * q * i * o)) * L)))) * L * D) (block : D)
    : Tezos_raw_protocol_alpha.Alpha_context.Script.expr * string ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        Tezos_raw_protocol_alpha.Alpha_context.Script.expr) :=
    RPC_context.make_call0 S.entrypoint_type ctxt block tt.
  
  Definition list_entrypoints {D E G I K L a b c i o q : Set}
    (ctxt :
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
          (* `POST *) unit + (* `PUT *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
      D -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (E * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
            (* `POST *) unit + (* `PUT *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i
          o -> D -> a -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (G * a * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
              (* `POST *) unit + (* `PUT *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
              b) q i o -> D -> a -> b -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (I * a * b * q * i * o)) *
            (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
              ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
                (* `POST *) unit + (* `PUT *) unit)
              Tezos_protocol_environment_alpha__Environment.RPC_context.t
              (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
                * b) * c) q i o -> D -> a -> b -> c -> q -> i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (K * a * b * c * q * i * o)) * L)))) * L * D) (block : D)
    : Tezos_raw_protocol_alpha.Alpha_context.Script.expr ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        (list (list Tezos_raw_protocol_alpha.Michelson_v1_primitives.prim) *
          list (string * Tezos_raw_protocol_alpha.Alpha_context.Script.expr))) :=
    RPC_context.make_call0 S.list_entrypoints ctxt block tt.
End Scripts.

Module Forge.
  Module S.
    Import Data_encoding.
    
    Definition path
      : Tezos_protocol_environment_alpha__Environment.RPC_path.path
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context :=
      op_div path "forge" % string.
    
    Definition operations
      : Tezos_protocol_environment_alpha__Environment.RPC_service.service
        (* `POST *) unit
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context unit
        (Tezos_protocol_environment_alpha__Environment.Operation.shell_header *
          Tezos_raw_protocol_alpha__Alpha_context.packed_contents_list)
        Tezos_protocol_environment_alpha__Environment.MBytes.t :=
      RPC_service.post_service (Some "Forge an operation" % string)
        RPC_query.empty Operation.unsigned_encoding __bytes_value
        (op_div path "operations" % string).
    
    Definition empty_proof_of_work_nonce
      : Tezos_protocol_environment_alpha__Environment.MBytes.t :=
      MBytes.of_string
        (String.make Constants_repr.proof_of_work_nonce_size "000" % char).
    
    Definition protocol_data
      : Tezos_protocol_environment_alpha__Environment.RPC_service.service
        (* `POST *) unit
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context unit
        (Z * option Tezos_raw_protocol_alpha.Nonce_hash.t *
          Tezos_protocol_environment_alpha__Environment.MBytes.t)
        Tezos_protocol_environment_alpha__Environment.MBytes.t :=
      RPC_service.post_service
        (Some "Forge the protocol-specific part of a block header" % string)
        RPC_query.empty
        (obj3 (req None None "priority" % string uint16)
          (opt None None "nonce_hash" % string Nonce_hash.encoding)
          (dft None None "proof_of_work_nonce" % string
            (Fixed.__bytes_value
              Alpha_context.Constants.proof_of_work_nonce_size)
            empty_proof_of_work_nonce))
        (obj1 (req None None "protocol_data" % string __bytes_value))
        (op_div path "protocol_data" % string).
  End S.
  
  Definition register (function_parameter : unit) : unit :=
    let 'tt := function_parameter in
    (* ❌ Sequences of instructions are not handled (operator ";") *)
    let _ :=
      register0_noctxt S.operations
        (fun function_parameter =>
          let 'tt := function_parameter in
          fun function_parameter =>
            let '(shell, proto) := function_parameter in
            __return
              (Data_encoding.Binary.to_bytes_exn Operation.unsigned_encoding
                (shell, proto))) in
    register0_noctxt S.protocol_data
      (fun function_parameter =>
        let 'tt := function_parameter in
        fun function_parameter =>
          let '(priority, seed_nonce_hash, proof_of_work_nonce) :=
            function_parameter in
          __return
            (Data_encoding.Binary.to_bytes_exn Block_header.contents_encoding
              {|
                Tezos_raw_protocol_alpha.Alpha_context.Block_header.contents.priority :=
                  priority;
                Tezos_raw_protocol_alpha.Alpha_context.Block_header.contents.seed_nonce_hash :=
                  seed_nonce_hash;
                Tezos_raw_protocol_alpha.Alpha_context.Block_header.contents.proof_of_work_nonce :=
                  proof_of_work_nonce |})).
  
  Module Manager.
    Definition operations {D E G I K L a b c i o q : Set}
      (ctxt :
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
            (* `POST *) unit + (* `PATCH *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
        D -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (E * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
              (* `POST *) unit + (* `PATCH *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q
            i o -> D -> a -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (G * a * q * i * o)) *
            (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
              ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
                (* `POST *) unit + (* `PATCH *) unit)
              Tezos_protocol_environment_alpha__Environment.RPC_context.t
              ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
                * b) q i o -> D -> a -> b -> q -> i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (I * a * b * q * i * o)) *
              (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
                ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
                  (* `POST *) unit + (* `PATCH *) unit)
                Tezos_protocol_environment_alpha__Environment.RPC_context.t
                (((Tezos_protocol_environment_alpha__Environment.RPC_context.t *
                  a) * b) * c) q i o -> D -> a -> b -> c -> q -> i ->
              Tezos_protocol_environment_alpha__Environment.Lwt.t
                (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                  o)) * (K * a * b * c * q * i * o)) * L)))) * L * D)
      (block : D)
      (branch : Tezos_protocol_environment_alpha__Environment.Block_hash.t)
      (source : Tezos_raw_protocol_alpha.Alpha_context.public_key_hash)
      (sourcePubKey :
        option
          Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t)
      (counter : Tezos_raw_protocol_alpha.Alpha_context.counter)
      (fee : Tezos_raw_protocol_alpha.Alpha_context.Tez.tez)
      (gas_limit : Tezos_protocol_environment_alpha__Environment.Z.t)
      (storage_limit : Tezos_protocol_environment_alpha__Environment.Z.t)
      (operations :
        list Tezos_raw_protocol_alpha.Alpha_context.packed_manager_operation)
      : Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Pervasives.result
          Tezos_protocol_environment_alpha__Environment.MBytes.t
          (list
            Tezos_protocol_environment_alpha__Environment.Error_monad.shell_error)) :=
      op_gtgteq (Contract_services.manager_key ctxt block source)
        (fun function_parameter =>
          match function_parameter with
          |
            (Tezos_protocol_environment_alpha__Environment.Pervasives.Error _)
              as e => Lwt.__return e
          | Tezos_protocol_environment_alpha__Environment.Pervasives.Ok revealed
            =>
            let ops :=
              List.map
                (fun function_parameter =>
                  let
                    'Tezos_raw_protocol_alpha.Alpha_context.Manager operation :=
                    function_parameter in
                  Tezos_raw_protocol_alpha.Alpha_context.Contents
                    (Tezos_raw_protocol_alpha.Alpha_context.Manager_operation
                      {|
                        Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.source :=
                          source;
                        Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.fee :=
                          fee;
                        Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.counter :=
                          counter;
                        Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.operation :=
                          operation;
                        Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.gas_limit :=
                          gas_limit;
                        Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.storage_limit :=
                          storage_limit |})) operations in
            let ops :=
              match (sourcePubKey, revealed) with
              | (None, _) | (_, Some _) => ops
              | (Some pk, None) =>
                let operation :=
                  Tezos_raw_protocol_alpha.Alpha_context.Reveal pk in
                cons
                  (Tezos_raw_protocol_alpha.Alpha_context.Contents
                    (Tezos_raw_protocol_alpha.Alpha_context.Manager_operation
                      {|
                        Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.source :=
                          source;
                        Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.fee :=
                          fee;
                        Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.counter :=
                          counter;
                        Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.operation :=
                          operation;
                        Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.gas_limit :=
                          gas_limit;
                        Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.storage_limit :=
                          storage_limit |})) ops
              end in
            RPC_context.make_call0 S.operations ctxt block tt
              ({|
                Tezos_protocol_environment_alpha__Environment.Operation.shell_header.branch :=
                  branch |}, (Operation.of_list ops))
          end).
    
    Definition reveal {D E G I K L a b c i o q : Set}
      (ctxt :
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
            (* `POST *) unit + (* `PATCH *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
        D -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (E * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
              (* `POST *) unit + (* `PATCH *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q
            i o -> D -> a -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (G * a * q * i * o)) *
            (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
              ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
                (* `POST *) unit + (* `PATCH *) unit)
              Tezos_protocol_environment_alpha__Environment.RPC_context.t
              ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
                * b) q i o -> D -> a -> b -> q -> i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (I * a * b * q * i * o)) *
              (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
                ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
                  (* `POST *) unit + (* `PATCH *) unit)
                Tezos_protocol_environment_alpha__Environment.RPC_context.t
                (((Tezos_protocol_environment_alpha__Environment.RPC_context.t *
                  a) * b) * c) q i o -> D -> a -> b -> c -> q -> i ->
              Tezos_protocol_environment_alpha__Environment.Lwt.t
                (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                  o)) * (K * a * b * c * q * i * o)) * L)))) * L * D)
      (block : D)
      (branch : Tezos_protocol_environment_alpha__Environment.Block_hash.t)
      (source : Tezos_raw_protocol_alpha.Alpha_context.public_key_hash)
      (sourcePubKey :
        Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t)
      (counter : Tezos_raw_protocol_alpha.Alpha_context.counter)
      (fee : Tezos_raw_protocol_alpha.Alpha_context.Tez.tez)
      (function_parameter : unit)
      : Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Pervasives.result
          Tezos_protocol_environment_alpha__Environment.MBytes.t
          (list
            Tezos_protocol_environment_alpha__Environment.Error_monad.shell_error)) :=
      let 'tt := function_parameter in
      operations ctxt block branch source (Some sourcePubKey) counter fee Z.zero
        Z.zero [].
    
    Definition transaction {D E G I K L a b c i o q : Set}
      (ctxt :
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
            (* `POST *) unit + (* `PATCH *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
        D -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (E * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
              (* `POST *) unit + (* `PATCH *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q
            i o -> D -> a -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (G * a * q * i * o)) *
            (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
              ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
                (* `POST *) unit + (* `PATCH *) unit)
              Tezos_protocol_environment_alpha__Environment.RPC_context.t
              ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
                * b) q i o -> D -> a -> b -> q -> i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (I * a * b * q * i * o)) *
              (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
                ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
                  (* `POST *) unit + (* `PATCH *) unit)
                Tezos_protocol_environment_alpha__Environment.RPC_context.t
                (((Tezos_protocol_environment_alpha__Environment.RPC_context.t *
                  a) * b) * c) q i o -> D -> a -> b -> c -> q -> i ->
              Tezos_protocol_environment_alpha__Environment.Lwt.t
                (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                  o)) * (K * a * b * c * q * i * o)) * L)))) * L * D)
      (block : D)
      (branch : Tezos_protocol_environment_alpha__Environment.Block_hash.t)
      (source : Tezos_raw_protocol_alpha.Alpha_context.public_key_hash)
      (sourcePubKey :
        option
          Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t)
      (counter : Tezos_raw_protocol_alpha.Alpha_context.counter)
      (amount : Tezos_raw_protocol_alpha.Alpha_context.Tez.tez)
      (destination : Tezos_raw_protocol_alpha.Alpha_context.Contract.contract)
      (op_staroptstar : option string)
      : option Tezos_raw_protocol_alpha.Alpha_context.Script.expr ->
      Tezos_protocol_environment_alpha__Environment.Z.t ->
      Tezos_protocol_environment_alpha__Environment.Z.t ->
      Tezos_raw_protocol_alpha.Alpha_context.Tez.tez -> unit ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Pervasives.result
          Tezos_protocol_environment_alpha__Environment.MBytes.t
          (list
            Tezos_protocol_environment_alpha__Environment.Error_monad.shell_error)) :=
      let entrypoint :=
        match op_staroptstar with
        | Some op_starsthstar => op_starsthstar
        | None => "default" % string
        end in
      fun parameters =>
        fun gas_limit =>
          fun storage_limit =>
            fun fee =>
              fun function_parameter =>
                let 'tt := function_parameter in
                let parameters :=
                  Option.unopt_map Script.lazy_expr Script.unit_parameter
                    parameters in
                operations ctxt block branch source sourcePubKey counter fee
                  gas_limit storage_limit
                  (cons
                    (Tezos_raw_protocol_alpha.Alpha_context.Manager
                      (Tezos_raw_protocol_alpha.Alpha_context.Transaction
                        {|
                          Tezos_raw_protocol_alpha.Alpha_context.manager_operation.Transaction.amount :=
                            amount;
                          Tezos_raw_protocol_alpha.Alpha_context.manager_operation.Transaction.parameters :=
                            parameters;
                          Tezos_raw_protocol_alpha.Alpha_context.manager_operation.Transaction.entrypoint :=
                            entrypoint;
                          Tezos_raw_protocol_alpha.Alpha_context.manager_operation.Transaction.destination :=
                            destination |})) []).
    
    Definition origination {D E G I K L a b c i o q : Set}
      (ctxt :
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
            (* `POST *) unit + (* `PATCH *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
        D -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (E * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
              (* `POST *) unit + (* `PATCH *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q
            i o -> D -> a -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (G * a * q * i * o)) *
            (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
              ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
                (* `POST *) unit + (* `PATCH *) unit)
              Tezos_protocol_environment_alpha__Environment.RPC_context.t
              ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
                * b) q i o -> D -> a -> b -> q -> i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (I * a * b * q * i * o)) *
              (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
                ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
                  (* `POST *) unit + (* `PATCH *) unit)
                Tezos_protocol_environment_alpha__Environment.RPC_context.t
                (((Tezos_protocol_environment_alpha__Environment.RPC_context.t *
                  a) * b) * c) q i o -> D -> a -> b -> c -> q -> i ->
              Tezos_protocol_environment_alpha__Environment.Lwt.t
                (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                  o)) * (K * a * b * c * q * i * o)) * L)))) * L * D)
      (block : D)
      (branch : Tezos_protocol_environment_alpha__Environment.Block_hash.t)
      (source : Tezos_raw_protocol_alpha.Alpha_context.public_key_hash)
      (sourcePubKey :
        option
          Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t)
      (counter : Tezos_raw_protocol_alpha.Alpha_context.counter)
      (balance : Tezos_raw_protocol_alpha.Alpha_context.Tez.tez)
      (delegatePubKey :
        option
          Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
      (script : Tezos_raw_protocol_alpha.Alpha_context.Script.t)
      (gas_limit : Tezos_protocol_environment_alpha__Environment.Z.t)
      (storage_limit : Tezos_protocol_environment_alpha__Environment.Z.t)
      (fee : Tezos_raw_protocol_alpha.Alpha_context.Tez.tez)
      (function_parameter : unit)
      : Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Pervasives.result
          Tezos_protocol_environment_alpha__Environment.MBytes.t
          (list
            Tezos_protocol_environment_alpha__Environment.Error_monad.shell_error)) :=
      let 'tt := function_parameter in
      operations ctxt block branch source sourcePubKey counter fee gas_limit
        storage_limit
        (cons
          (Tezos_raw_protocol_alpha.Alpha_context.Manager
            (Tezos_raw_protocol_alpha.Alpha_context.Origination
              {|
                Tezos_raw_protocol_alpha.Alpha_context.manager_operation.Origination.delegate :=
                  delegatePubKey;
                Tezos_raw_protocol_alpha.Alpha_context.manager_operation.Origination.script :=
                  script;
                Tezos_raw_protocol_alpha.Alpha_context.manager_operation.Origination.credit :=
                  balance;
                Tezos_raw_protocol_alpha.Alpha_context.manager_operation.Origination.preorigination :=
                  None |})) []).
    
    Definition delegation {D E G I K L a b c i o q : Set}
      (ctxt :
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
            (* `POST *) unit + (* `PATCH *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
        D -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (E * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
              (* `POST *) unit + (* `PATCH *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q
            i o -> D -> a -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (G * a * q * i * o)) *
            (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
              ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
                (* `POST *) unit + (* `PATCH *) unit)
              Tezos_protocol_environment_alpha__Environment.RPC_context.t
              ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
                * b) q i o -> D -> a -> b -> q -> i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (I * a * b * q * i * o)) *
              (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
                ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
                  (* `POST *) unit + (* `PATCH *) unit)
                Tezos_protocol_environment_alpha__Environment.RPC_context.t
                (((Tezos_protocol_environment_alpha__Environment.RPC_context.t *
                  a) * b) * c) q i o -> D -> a -> b -> c -> q -> i ->
              Tezos_protocol_environment_alpha__Environment.Lwt.t
                (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                  o)) * (K * a * b * c * q * i * o)) * L)))) * L * D)
      (block : D)
      (branch : Tezos_protocol_environment_alpha__Environment.Block_hash.t)
      (source : Tezos_raw_protocol_alpha.Alpha_context.public_key_hash)
      (sourcePubKey :
        option
          Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t)
      (counter : Tezos_raw_protocol_alpha.Alpha_context.counter)
      (fee : Tezos_raw_protocol_alpha.Alpha_context.Tez.tez)
      (delegate :
        option
          Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
      : Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Pervasives.result
          Tezos_protocol_environment_alpha__Environment.MBytes.t
          (list
            Tezos_protocol_environment_alpha__Environment.Error_monad.shell_error)) :=
      operations ctxt block branch source sourcePubKey counter fee Z.zero Z.zero
        (cons
          (Tezos_raw_protocol_alpha.Alpha_context.Manager
            (Tezos_raw_protocol_alpha.Alpha_context.Delegation delegate)) []).
  End Manager.
  
  Definition operation {D E G I K L M a b c i o q : Set}
    (ctxt :
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
          (* `POST *) unit + (* `PUT *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
      D -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (E * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
            (* `POST *) unit + (* `PUT *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i
          o -> D -> a -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (G * a * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
              (* `POST *) unit + (* `PUT *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
              b) q i o -> D -> a -> b -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (I * a * b * q * i * o)) *
            (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
              ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
                (* `POST *) unit + (* `PUT *) unit)
              Tezos_protocol_environment_alpha__Environment.RPC_context.t
              (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
                * b) * c) q i o -> D -> a -> b -> c -> q -> i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (K * a * b * c * q * i * o)) * L)))) * L * D) (block : D)
    (branch : Tezos_protocol_environment_alpha__Environment.Block_hash.t)
    (operation : Tezos_raw_protocol_alpha.Alpha_context.contents M)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        Tezos_protocol_environment_alpha__Environment.MBytes.t) :=
    RPC_context.make_call0 S.operations ctxt block tt
      ({|
        Tezos_protocol_environment_alpha__Environment.Operation.shell_header.branch :=
          branch |},
        (Tezos_raw_protocol_alpha.Alpha_context.Contents_list
          (Tezos_raw_protocol_alpha.Alpha_context.Single operation))).
  
  Definition endorsement {D E G I K L a b c i o q : Set}
    (ctxt :
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
          (* `POST *) unit + (* `PUT *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
      D -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (E * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
            (* `POST *) unit + (* `PUT *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i
          o -> D -> a -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (G * a * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
              (* `POST *) unit + (* `PUT *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
              b) q i o -> D -> a -> b -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (I * a * b * q * i * o)) *
            (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
              ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
                (* `POST *) unit + (* `PUT *) unit)
              Tezos_protocol_environment_alpha__Environment.RPC_context.t
              (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
                * b) * c) q i o -> D -> a -> b -> c -> q -> i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (K * a * b * c * q * i * o)) * L)))) * L * D) (b : D)
    (branch : Tezos_protocol_environment_alpha__Environment.Block_hash.t)
    (level : Tezos_raw_protocol_alpha.Alpha_context.Raw_level.t)
    (function_parameter : unit)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        Tezos_protocol_environment_alpha__Environment.MBytes.t) :=
    let 'tt := function_parameter in
    operation ctxt b branch
      (Tezos_raw_protocol_alpha.Alpha_context.Endorsement
        {|
          Tezos_raw_protocol_alpha.Alpha_context.contents.Endorsement.level :=
            level |}).
  
  Definition proposals {D E G I K L a b c i o q : Set}
    (ctxt :
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
          (* `POST *) unit + (* `PUT *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
      D -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (E * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
            (* `POST *) unit + (* `PUT *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i
          o -> D -> a -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (G * a * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
              (* `POST *) unit + (* `PUT *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
              b) q i o -> D -> a -> b -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (I * a * b * q * i * o)) *
            (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
              ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
                (* `POST *) unit + (* `PUT *) unit)
              Tezos_protocol_environment_alpha__Environment.RPC_context.t
              (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
                * b) * c) q i o -> D -> a -> b -> c -> q -> i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (K * a * b * c * q * i * o)) * L)))) * L * D) (b : D)
    (branch : Tezos_protocol_environment_alpha__Environment.Block_hash.t)
    (source :
      Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
    (period : Tezos_raw_protocol_alpha.Alpha_context.Voting_period.t)
    (proposals :
      list Tezos_protocol_environment_alpha__Environment.Protocol_hash.t)
    (function_parameter : unit)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        Tezos_protocol_environment_alpha__Environment.MBytes.t) :=
    let 'tt := function_parameter in
    operation ctxt b branch
      (Tezos_raw_protocol_alpha.Alpha_context.Proposals
        {|
          Tezos_raw_protocol_alpha.Alpha_context.contents.Proposals.source :=
            source;
          Tezos_raw_protocol_alpha.Alpha_context.contents.Proposals.period :=
            period;
          Tezos_raw_protocol_alpha.Alpha_context.contents.Proposals.proposals :=
            proposals |}).
  
  Definition ballot {D E G I K L a b c i o q : Set}
    (ctxt :
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
          (* `POST *) unit + (* `PUT *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
      D -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (E * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
            (* `POST *) unit + (* `PUT *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i
          o -> D -> a -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (G * a * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
              (* `POST *) unit + (* `PUT *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
              b) q i o -> D -> a -> b -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (I * a * b * q * i * o)) *
            (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
              ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
                (* `POST *) unit + (* `PUT *) unit)
              Tezos_protocol_environment_alpha__Environment.RPC_context.t
              (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
                * b) * c) q i o -> D -> a -> b -> c -> q -> i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (K * a * b * c * q * i * o)) * L)))) * L * D) (b : D)
    (branch : Tezos_protocol_environment_alpha__Environment.Block_hash.t)
    (source :
      Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
    (period : Tezos_raw_protocol_alpha.Alpha_context.Voting_period.t)
    (proposal : Tezos_protocol_environment_alpha__Environment.Protocol_hash.t)
    (ballot : Tezos_raw_protocol_alpha.Alpha_context.Vote.ballot)
    (function_parameter : unit)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        Tezos_protocol_environment_alpha__Environment.MBytes.t) :=
    let 'tt := function_parameter in
    operation ctxt b branch
      (Tezos_raw_protocol_alpha.Alpha_context.Ballot
        {|
          Tezos_raw_protocol_alpha.Alpha_context.contents.Ballot.source :=
            source;
          Tezos_raw_protocol_alpha.Alpha_context.contents.Ballot.period :=
            period;
          Tezos_raw_protocol_alpha.Alpha_context.contents.Ballot.proposal :=
            proposal;
          Tezos_raw_protocol_alpha.Alpha_context.contents.Ballot.ballot :=
            ballot |}).
  
  Definition seed_nonce_revelation {D E G I K L a b c i o q : Set}
    (ctxt :
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
          (* `POST *) unit + (* `PUT *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
      D -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (E * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
            (* `POST *) unit + (* `PUT *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i
          o -> D -> a -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (G * a * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
              (* `POST *) unit + (* `PUT *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
              b) q i o -> D -> a -> b -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (I * a * b * q * i * o)) *
            (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
              ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
                (* `POST *) unit + (* `PUT *) unit)
              Tezos_protocol_environment_alpha__Environment.RPC_context.t
              (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
                * b) * c) q i o -> D -> a -> b -> c -> q -> i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (K * a * b * c * q * i * o)) * L)))) * L * D) (block : D)
    (branch : Tezos_protocol_environment_alpha__Environment.Block_hash.t)
    (level : Tezos_raw_protocol_alpha.Alpha_context.Raw_level.t)
    (nonce : Tezos_raw_protocol_alpha.Alpha_context.Nonce.t)
    (function_parameter : unit)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        Tezos_protocol_environment_alpha__Environment.MBytes.t) :=
    let 'tt := function_parameter in
    operation ctxt block branch
      (Tezos_raw_protocol_alpha.Alpha_context.Seed_nonce_revelation
        {|
          Tezos_raw_protocol_alpha.Alpha_context.contents.Seed_nonce_revelation.level :=
            level;
          Tezos_raw_protocol_alpha.Alpha_context.contents.Seed_nonce_revelation.nonce :=
            nonce |}).
  
  Definition double_baking_evidence {D E G I K L a b c i o q : Set}
    (ctxt :
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
          (* `POST *) unit + (* `PUT *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
      D -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (E * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
            (* `POST *) unit + (* `PUT *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i
          o -> D -> a -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (G * a * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
              (* `POST *) unit + (* `PUT *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
              b) q i o -> D -> a -> b -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (I * a * b * q * i * o)) *
            (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
              ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
                (* `POST *) unit + (* `PUT *) unit)
              Tezos_protocol_environment_alpha__Environment.RPC_context.t
              (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
                * b) * c) q i o -> D -> a -> b -> c -> q -> i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (K * a * b * c * q * i * o)) * L)))) * L * D) (block : D)
    (branch : Tezos_protocol_environment_alpha__Environment.Block_hash.t)
    (bh1 : Tezos_raw_protocol_alpha.Alpha_context.Block_header.t)
    (bh2 : Tezos_raw_protocol_alpha.Alpha_context.Block_header.t)
    (function_parameter : unit)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        Tezos_protocol_environment_alpha__Environment.MBytes.t) :=
    let 'tt := function_parameter in
    operation ctxt block branch
      (Tezos_raw_protocol_alpha.Alpha_context.Double_baking_evidence
        {|
          Tezos_raw_protocol_alpha.Alpha_context.contents.Double_baking_evidence.bh1 :=
            bh1;
          Tezos_raw_protocol_alpha.Alpha_context.contents.Double_baking_evidence.bh2 :=
            bh2 |}).
  
  Definition double_endorsement_evidence {D E G I K L a b c i o q : Set}
    (ctxt :
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
          (* `POST *) unit + (* `PUT *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
      D -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (E * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
            (* `POST *) unit + (* `PUT *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i
          o -> D -> a -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (G * a * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
              (* `POST *) unit + (* `PUT *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
              b) q i o -> D -> a -> b -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (I * a * b * q * i * o)) *
            (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
              ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
                (* `POST *) unit + (* `PUT *) unit)
              Tezos_protocol_environment_alpha__Environment.RPC_context.t
              (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
                * b) * c) q i o -> D -> a -> b -> c -> q -> i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (K * a * b * c * q * i * o)) * L)))) * L * D) (block : D)
    (branch : Tezos_protocol_environment_alpha__Environment.Block_hash.t)
    (op1 :
      Tezos_raw_protocol_alpha.Alpha_context.operation
        Tezos_raw_protocol_alpha.Alpha_context.Kind.endorsement)
    (op2 :
      Tezos_raw_protocol_alpha.Alpha_context.operation
        Tezos_raw_protocol_alpha.Alpha_context.Kind.endorsement)
    (function_parameter : unit)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        Tezos_protocol_environment_alpha__Environment.MBytes.t) :=
    let 'tt := function_parameter in
    operation ctxt block branch
      (Tezos_raw_protocol_alpha.Alpha_context.Double_endorsement_evidence
        {|
          Tezos_raw_protocol_alpha.Alpha_context.contents.Double_endorsement_evidence.op1 :=
            op1;
          Tezos_raw_protocol_alpha.Alpha_context.contents.Double_endorsement_evidence.op2 :=
            op2 |}).
  
  Definition empty_proof_of_work_nonce
    : Tezos_protocol_environment_alpha__Environment.MBytes.t :=
    MBytes.of_string
      (String.make Constants_repr.proof_of_work_nonce_size "000" % char).
  
  Definition protocol_data {D E G I K L a b c i o q : Set}
    (ctxt :
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
          (* `POST *) unit + (* `PUT *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
      D -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (E * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
            (* `POST *) unit + (* `PUT *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i
          o -> D -> a -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (G * a * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
              (* `POST *) unit + (* `PUT *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
              b) q i o -> D -> a -> b -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (I * a * b * q * i * o)) *
            (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
              ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
                (* `POST *) unit + (* `PUT *) unit)
              Tezos_protocol_environment_alpha__Environment.RPC_context.t
              (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
                * b) * c) q i o -> D -> a -> b -> c -> q -> i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (K * a * b * c * q * i * o)) * L)))) * L * D) (block : D)
    (priority : Z)
    (seed_nonce_hash : option Tezos_raw_protocol_alpha.Nonce_hash.t)
    (op_staroptstar :
      option Tezos_protocol_environment_alpha__Environment.MBytes.t)
    : unit ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        Tezos_protocol_environment_alpha__Environment.MBytes.t) :=
    let proof_of_work_nonce :=
      match op_staroptstar with
      | Some op_starsthstar => op_starsthstar
      | None => empty_proof_of_work_nonce
      end in
    fun function_parameter =>
      let 'tt := function_parameter in
      RPC_context.make_call0 S.protocol_data ctxt block tt
        (priority, seed_nonce_hash, proof_of_work_nonce).
End Forge.

Module Parse.
  Module S.
    Import Data_encoding.
    
    Definition path
      : Tezos_protocol_environment_alpha__Environment.RPC_path.path
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context :=
      op_div path "parse" % string.
    
    Definition operations
      : Tezos_protocol_environment_alpha__Environment.RPC_service.service
        (* `POST *) unit
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context unit
        (list Tezos_raw_protocol_alpha.Alpha_context.Operation.raw * option bool)
        (list Tezos_raw_protocol_alpha.Alpha_context.Operation.packed) :=
      RPC_service.post_service (Some "Parse operations" % string)
        RPC_query.empty
        (obj2
          (req None None "operations" % string
            (__list_value None (dynamic_size None Operation.raw_encoding)))
          (opt None None "check_signature" % string __bool_value))
        (__list_value None (dynamic_size None Operation.encoding))
        (op_div path "operations" % string).
    
    Definition block
      : Tezos_protocol_environment_alpha__Environment.RPC_service.service
        (* `POST *) unit
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context unit
        Tezos_raw_protocol_alpha.Alpha_context.Block_header.raw
        Tezos_raw_protocol_alpha.Alpha_context.Block_header.protocol_data :=
      RPC_service.post_service (Some "Parse a block" % string) RPC_query.empty
        Block_header.raw_encoding Block_header.protocol_data_encoding
        (op_div path "block" % string).
  End S.
  
  Definition parse_protocol_data
    (protocol_data : Tezos_protocol_environment_alpha__Environment.MBytes.t)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        Tezos_raw_protocol_alpha.Alpha_context.Block_header.protocol_data) :=
    match
      Data_encoding.Binary.of_bytes Block_header.protocol_data_encoding
        protocol_data with
    | None => failwith "Cant_parse_protocol_data" % string
    | Some protocol_data => __return protocol_data
    end.
  
  Definition register (function_parameter : unit) : unit :=
    let 'tt := function_parameter in
    (* ❌ Sequences of instructions are not handled (operator ";") *)
    let _ :=
      register0 S.operations
        (fun _ctxt =>
          fun function_parameter =>
            let 'tt := function_parameter in
            fun function_parameter =>
              let '(operations, check) := function_parameter in
              map_s
                (fun raw =>
                  op_gtgteqquestion (Lwt.__return (parse_operation raw))
                    (fun op =>
                      op_gtgtpipequestion
                        match check with
                        | Some true => return_unit
                        | Some false | None => return_unit
                        end
                        (fun function_parameter =>
                          let 'tt := function_parameter in
                          op))) operations) in
    register0_noctxt S.block
      (fun function_parameter =>
        let 'tt := function_parameter in
        fun raw_block =>
          parse_protocol_data
            (Tezos_protocol_environment_alpha__Environment.Block_header.t.protocol_data
              raw_block)).
  
  Definition operations {D E G I K L a b c i o q : Set}
    (ctxt :
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
          (* `POST *) unit + (* `PUT *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
      D -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (E * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
            (* `POST *) unit + (* `PUT *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i
          o -> D -> a -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (G * a * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
              (* `POST *) unit + (* `PUT *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
              b) q i o -> D -> a -> b -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (I * a * b * q * i * o)) *
            (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
              ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
                (* `POST *) unit + (* `PUT *) unit)
              Tezos_protocol_environment_alpha__Environment.RPC_context.t
              (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
                * b) * c) q i o -> D -> a -> b -> c -> q -> i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (K * a * b * c * q * i * o)) * L)))) * L * D) (block : D)
    (check : option bool)
    (operations : list Tezos_raw_protocol_alpha.Alpha_context.Operation.raw)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        (list Tezos_raw_protocol_alpha.Alpha_context.Operation.packed)) :=
    RPC_context.make_call0 S.operations ctxt block tt (operations, check).
  
  Definition block {D E G I K L a b c i o q : Set}
    (ctxt :
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
          (* `POST *) unit + (* `PUT *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
      D -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (E * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
            (* `POST *) unit + (* `PUT *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i
          o -> D -> a -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (G * a * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
              (* `POST *) unit + (* `PUT *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
              b) q i o -> D -> a -> b -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (I * a * b * q * i * o)) *
            (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
              ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
                (* `POST *) unit + (* `PUT *) unit)
              Tezos_protocol_environment_alpha__Environment.RPC_context.t
              (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
                * b) * c) q i o -> D -> a -> b -> c -> q -> i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (K * a * b * c * q * i * o)) * L)))) * L * D) (block : D)
    (shell :
      Tezos_protocol_environment_alpha__Environment.Block_header.shell_header)
    (protocol_data : Tezos_protocol_environment_alpha__Environment.MBytes.t)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        Tezos_raw_protocol_alpha.Alpha_context.Block_header.protocol_data) :=
    RPC_context.make_call0 S.block ctxt block tt
      {|
        Tezos_protocol_environment_alpha__Environment.Block_header.t.shell :=
          shell;
        Tezos_protocol_environment_alpha__Environment.Block_header.t.protocol_data :=
          protocol_data |}.
End Parse.

Module S.
  Import Data_encoding.
  
  Module level_query.
    Record record := {
      offset : int32 }.
  End level_query.
  Definition level_query := level_query.record.
  
  Definition level_query
    : Tezos_protocol_environment_alpha__Environment.RPC_query.t level_query :=
    op_pipegt
      (op_pipeplus
        (__query_value (fun offset => {| level_query.offset := offset |}))
        (__field_value None "offset" % string RPC_arg.__int32_value
          (* ❌ Constant of type int32 is converted to int *)
          0 (fun t => level_query.offset t))) seal.
  
  Definition current_level
    : Tezos_protocol_environment_alpha__Environment.RPC_service.service
      (* `GET *) unit
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
      level_query unit Tezos_raw_protocol_alpha.Alpha_context.Level.t :=
    RPC_service.get_service
      (Some
        "Returns the level of the interrogated block, or the one of a block located `offset` blocks after in the chain (or before when negative). For instance, the next block if `offset` is 1."
          % string) level_query Level.encoding
      (op_div path "current_level" % string).
  
  Definition levels_in_current_cycle
    : Tezos_protocol_environment_alpha__Environment.RPC_service.service
      (* `GET *) unit
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
      level_query unit
      (Tezos_raw_protocol_alpha.Alpha_context.Raw_level.t *
        Tezos_raw_protocol_alpha.Alpha_context.Raw_level.t) :=
    RPC_service.get_service (Some "Levels of a cycle" % string) level_query
      (obj2 (req None None "first" % string Raw_level.encoding)
        (req None None "last" % string Raw_level.encoding))
      (op_div path "levels_in_current_cycle" % string).
End S.

Definition register (function_parameter : unit) : unit :=
  let 'tt := function_parameter in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ := Scripts.register tt in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ := Forge.register tt in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ := Parse.register tt in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register0 S.current_level
      (fun ctxt =>
        fun q =>
          fun function_parameter =>
            let 'tt := function_parameter in
            let level := Level.current ctxt in
            __return
              (Level.from_raw ctxt (Some (S.level_query.offset q))
                (Tezos_raw_protocol_alpha.Alpha_context.Level.t.level level)))
    in
  register0 S.levels_in_current_cycle
    (fun ctxt =>
      fun q =>
        fun function_parameter =>
          let 'tt := function_parameter in
          let levels :=
            Level.levels_in_current_cycle ctxt (Some (S.level_query.offset q))
              tt in
          match levels with
          | [] => raise OCaml.Not_found
          | _ =>
            let first := List.hd (List.rev levels) in
            let last := List.hd levels in
            __return
              ((Tezos_raw_protocol_alpha.Alpha_context.Level.t.level first),
                (Tezos_raw_protocol_alpha.Alpha_context.Level.t.level last))
          end).

Definition current_level {D E G I K L a b c i o q : Set}
  (ctxt :
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
        (* `POST *) unit + (* `PUT *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> D ->
    q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
          (* `POST *) unit + (* `PUT *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
      -> D -> a -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (G * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
            (* `POST *) unit + (* `PUT *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o -> D -> a -> b -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (I * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
              (* `POST *) unit + (* `PUT *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o -> D -> a -> b -> c -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (K * a * b * c * q * i * o)) * L)))) * L * D)
  (op_staroptstar : option int32)
  : D ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      Tezos_raw_protocol_alpha.Alpha_context.Level.t) :=
  let offset :=
    match op_staroptstar with
    | Some op_starsthstar => op_starsthstar
    | None =>
      (* ❌ Constant of type int32 is converted to int *)
      0
    end in
  fun block =>
    RPC_context.make_call0 S.current_level ctxt block
      {| S.level_query.offset := offset |} tt.

Definition levels_in_current_cycle {D E G I K L a b c i o q : Set}
  (ctxt :
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
        (* `POST *) unit + (* `PUT *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> D ->
    q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
          (* `POST *) unit + (* `PUT *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
      -> D -> a -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (G * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
            (* `POST *) unit + (* `PUT *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o -> D -> a -> b -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (I * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
              (* `POST *) unit + (* `PUT *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o -> D -> a -> b -> c -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (K * a * b * c * q * i * o)) * L)))) * L * D)
  (op_staroptstar : option int32)
  : D ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      (Tezos_raw_protocol_alpha.Alpha_context.Raw_level.t *
        Tezos_raw_protocol_alpha.Alpha_context.Raw_level.t)) :=
  let offset :=
    match op_staroptstar with
    | Some op_starsthstar => op_starsthstar
    | None =>
      (* ❌ Constant of type int32 is converted to int *)
      0
    end in
  fun block =>
    RPC_context.make_call0 S.levels_in_current_cycle ctxt block
      {| S.level_query.offset := offset |} tt.

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Alpha_context

type error += Cannot_parse_operation (* `Branch *)

val current_level :
  'a #RPC_context.simple -> ?offset:int32 -> 'a -> Level.t shell_tzresult Lwt.t

val levels_in_current_cycle :
  'a #RPC_context.simple ->
  ?offset:int32 ->
  'a ->
  (Raw_level.t * Raw_level.t) shell_tzresult Lwt.t

module Scripts : sig
  val run_code :
    'a #RPC_context.simple ->
    'a ->
    Script.expr ->
    Script.expr
    * Script.expr
    * Tez.t
    * Chain_id.t
    * Contract.t option
    * Contract.t option
    * Z.t option
    * string ->
    ( Script.expr
    * packed_internal_operation list
    * Contract.big_map_diff option )
    shell_tzresult
    Lwt.t

  val trace_code :
    'a #RPC_context.simple ->
    'a ->
    Script.expr ->
    Script.expr
    * Script.expr
    * Tez.t
    * Chain_id.t
    * Contract.t option
    * Contract.t option
    * Z.t option
    * string ->
    ( Script.expr
    * packed_internal_operation list
    * Script_interpreter.execution_trace
    * Contract.big_map_diff option )
    shell_tzresult
    Lwt.t

  val typecheck_code :
    'a #RPC_context.simple ->
    'a ->
    Script.expr * Z.t option ->
    (Script_tc_errors.type_map * Gas.t) shell_tzresult Lwt.t

  val typecheck_data :
    'a #RPC_context.simple ->
    'a ->
    Script.expr * Script.expr * Z.t option ->
    Gas.t shell_tzresult Lwt.t

  val pack_data :
    'a #RPC_context.simple ->
    'a ->
    Script.expr * Script.expr * Z.t option ->
    (MBytes.t * Gas.t) shell_tzresult Lwt.t

  val run_operation :
    'a #RPC_context.simple ->
    'a ->
    packed_operation * Chain_id.t ->
    (packed_protocol_data * Apply_results.packed_operation_metadata)
    shell_tzresult
    Lwt.t

  val entrypoint_type :
    'a #RPC_context.simple ->
    'a ->
    Script.expr * string ->
    Script.expr shell_tzresult Lwt.t

  val list_entrypoints :
    'a #RPC_context.simple ->
    'a ->
    Script.expr ->
    (Michelson_v1_primitives.prim list list * (string * Script.expr) list)
    shell_tzresult
    Lwt.t
end

module Forge : sig
  module Manager : sig
    val operations :
      'a #RPC_context.simple ->
      'a ->
      branch:Block_hash.t ->
      source:public_key_hash ->
      ?sourcePubKey:public_key ->
      counter:counter ->
      fee:Tez.t ->
      gas_limit:Z.t ->
      storage_limit:Z.t ->
      packed_manager_operation list ->
      MBytes.t shell_tzresult Lwt.t

    val reveal :
      'a #RPC_context.simple ->
      'a ->
      branch:Block_hash.t ->
      source:public_key_hash ->
      sourcePubKey:public_key ->
      counter:counter ->
      fee:Tez.t ->
      unit ->
      MBytes.t shell_tzresult Lwt.t

    val transaction :
      'a #RPC_context.simple ->
      'a ->
      branch:Block_hash.t ->
      source:public_key_hash ->
      ?sourcePubKey:public_key ->
      counter:counter ->
      amount:Tez.t ->
      destination:Contract.t ->
      ?entrypoint:string ->
      ?parameters:Script.expr ->
      gas_limit:Z.t ->
      storage_limit:Z.t ->
      fee:Tez.t ->
      unit ->
      MBytes.t shell_tzresult Lwt.t

    val origination :
      'a #RPC_context.simple ->
      'a ->
      branch:Block_hash.t ->
      source:public_key_hash ->
      ?sourcePubKey:public_key ->
      counter:counter ->
      balance:Tez.t ->
      ?delegatePubKey:public_key_hash ->
      script:Script.t ->
      gas_limit:Z.t ->
      storage_limit:Z.t ->
      fee:Tez.t ->
      unit ->
      MBytes.t shell_tzresult Lwt.t

    val delegation :
      'a #RPC_context.simple ->
      'a ->
      branch:Block_hash.t ->
      source:public_key_hash ->
      ?sourcePubKey:public_key ->
      counter:counter ->
      fee:Tez.t ->
      public_key_hash option ->
      MBytes.t shell_tzresult Lwt.t
  end

  val endorsement :
    'a #RPC_context.simple ->
    'a ->
    branch:Block_hash.t ->
    level:Raw_level.t ->
    unit ->
    MBytes.t shell_tzresult Lwt.t

  val proposals :
    'a #RPC_context.simple ->
    'a ->
    branch:Block_hash.t ->
    source:public_key_hash ->
    period:Voting_period.t ->
    proposals:Protocol_hash.t list ->
    unit ->
    MBytes.t shell_tzresult Lwt.t

  val ballot :
    'a #RPC_context.simple ->
    'a ->
    branch:Block_hash.t ->
    source:public_key_hash ->
    period:Voting_period.t ->
    proposal:Protocol_hash.t ->
    ballot:Vote.ballot ->
    unit ->
    MBytes.t shell_tzresult Lwt.t

  val seed_nonce_revelation :
    'a #RPC_context.simple ->
    'a ->
    branch:Block_hash.t ->
    level:Raw_level.t ->
    nonce:Nonce.t ->
    unit ->
    MBytes.t shell_tzresult Lwt.t

  val double_baking_evidence :
    'a #RPC_context.simple ->
    'a ->
    branch:Block_hash.t ->
    bh1:Block_header.t ->
    bh2:Block_header.t ->
    unit ->
    MBytes.t shell_tzresult Lwt.t

  val double_endorsement_evidence :
    'a #RPC_context.simple ->
    'a ->
    branch:Block_hash.t ->
    op1:Kind.endorsement operation ->
    op2:Kind.endorsement operation ->
    unit ->
    MBytes.t shell_tzresult Lwt.t

  val protocol_data :
    'a #RPC_context.simple ->
    'a ->
    priority:int ->
    ?seed_nonce_hash:Nonce_hash.t ->
    ?proof_of_work_nonce:MBytes.t ->
    unit ->
    MBytes.t shell_tzresult Lwt.t
end

module Parse : sig
  val operations :
    'a #RPC_context.simple ->
    'a ->
    ?check:bool ->
    Operation.raw list ->
    Operation.packed list shell_tzresult Lwt.t

  val block :
    'a #RPC_context.simple ->
    'a ->
    Block_header.shell_header ->
    MBytes.t ->
    Block_header.protocol_data shell_tzresult Lwt.t
end

val register : unit -> unit

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

(* extensible_type Tezos_protocol_environment_alpha__Environment.Error_monad.error *)

Parameter current_level : forall {E F H J K a b c i o q : Set},
  (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
    ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit +
      (* `PATCH *) unit)
    Tezos_protocol_environment_alpha__Environment.RPC_context.t
    Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> a ->
  q -> i ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult o))
    * (E * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit
        + (* `PATCH *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
    a -> a -> q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (F * a * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
          (* `POST *) unit + (* `PATCH *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
        q i o -> a -> a -> b -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (H * a * b * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
            (* `POST *) unit + (* `PATCH *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
            b) * c) q i o -> a -> a -> b -> c -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (J * a * b * c * q * i * o)) * K)))) * K * a ->
  option int32 -> a ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      Tezos_raw_protocol_alpha.Alpha_context.Level.t).

Parameter levels_in_current_cycle : forall {E F H J K a b c i o q : Set},
  (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
    ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit +
      (* `PATCH *) unit)
    Tezos_protocol_environment_alpha__Environment.RPC_context.t
    Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> a ->
  q -> i ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult o))
    * (E * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit
        + (* `PATCH *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
    a -> a -> q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (F * a * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
          (* `POST *) unit + (* `PATCH *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
        q i o -> a -> a -> b -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (H * a * b * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
            (* `POST *) unit + (* `PATCH *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
            b) * c) q i o -> a -> a -> b -> c -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (J * a * b * c * q * i * o)) * K)))) * K * a ->
  option int32 -> a ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      (Tezos_raw_protocol_alpha.Alpha_context.Raw_level.t *
        Tezos_raw_protocol_alpha.Alpha_context.Raw_level.t)).

Module Scripts.
  Parameter run_code : forall {E F H J K a b c i o q : Set},
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit
        + (* `PATCH *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> a ->
    q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
          (* `POST *) unit + (* `PATCH *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
      -> a -> a -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (F * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
            (* `POST *) unit + (* `PATCH *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o -> a -> a -> b -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (H * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
              (* `POST *) unit + (* `PATCH *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o -> a -> a -> b -> c -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (J * a * b * c * q * i * o)) * K)))) * K * a -> a ->
    Tezos_raw_protocol_alpha.Alpha_context.Script.expr ->
    Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
      Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
      Tezos_raw_protocol_alpha.Alpha_context.Tez.t *
      Tezos_protocol_environment_alpha__Environment.Chain_id.t *
      option Tezos_raw_protocol_alpha.Alpha_context.Contract.t *
      option Tezos_raw_protocol_alpha.Alpha_context.Contract.t *
      option Tezos_protocol_environment_alpha__Environment.Z.t * string ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        (Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
          list Tezos_raw_protocol_alpha.Alpha_context.packed_internal_operation
          * option Tezos_raw_protocol_alpha.Alpha_context.Contract.big_map_diff)).
  
  Parameter trace_code : forall {E F H J K a b c i o q : Set},
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit
        + (* `PATCH *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> a ->
    q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
          (* `POST *) unit + (* `PATCH *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
      -> a -> a -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (F * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
            (* `POST *) unit + (* `PATCH *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o -> a -> a -> b -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (H * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
              (* `POST *) unit + (* `PATCH *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o -> a -> a -> b -> c -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (J * a * b * c * q * i * o)) * K)))) * K * a -> a ->
    Tezos_raw_protocol_alpha.Alpha_context.Script.expr ->
    Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
      Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
      Tezos_raw_protocol_alpha.Alpha_context.Tez.t *
      Tezos_protocol_environment_alpha__Environment.Chain_id.t *
      option Tezos_raw_protocol_alpha.Alpha_context.Contract.t *
      option Tezos_raw_protocol_alpha.Alpha_context.Contract.t *
      option Tezos_protocol_environment_alpha__Environment.Z.t * string ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        (Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
          list Tezos_raw_protocol_alpha.Alpha_context.packed_internal_operation
          * Tezos_raw_protocol_alpha.Script_interpreter.execution_trace *
          option Tezos_raw_protocol_alpha.Alpha_context.Contract.big_map_diff)).
  
  Parameter typecheck_code : forall {E F H J K a b c i o q : Set},
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit
        + (* `PATCH *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> a ->
    q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
          (* `POST *) unit + (* `PATCH *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
      -> a -> a -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (F * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
            (* `POST *) unit + (* `PATCH *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o -> a -> a -> b -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (H * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
              (* `POST *) unit + (* `PATCH *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o -> a -> a -> b -> c -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (J * a * b * c * q * i * o)) * K)))) * K * a -> a ->
    Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
      option Tezos_protocol_environment_alpha__Environment.Z.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        (Tezos_raw_protocol_alpha.Script_tc_errors.type_map *
          Tezos_raw_protocol_alpha.Alpha_context.Gas.t)).
  
  Parameter typecheck_data : forall {E F H J K a b c i o q : Set},
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit
        + (* `PATCH *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> a ->
    q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
          (* `POST *) unit + (* `PATCH *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
      -> a -> a -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (F * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
            (* `POST *) unit + (* `PATCH *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o -> a -> a -> b -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (H * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
              (* `POST *) unit + (* `PATCH *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o -> a -> a -> b -> c -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (J * a * b * c * q * i * o)) * K)))) * K * a -> a ->
    Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
      Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
      option Tezos_protocol_environment_alpha__Environment.Z.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        Tezos_raw_protocol_alpha.Alpha_context.Gas.t).
  
  Parameter pack_data : forall {E F H J K a b c i o q : Set},
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit
        + (* `PATCH *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> a ->
    q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
          (* `POST *) unit + (* `PATCH *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
      -> a -> a -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (F * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
            (* `POST *) unit + (* `PATCH *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o -> a -> a -> b -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (H * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
              (* `POST *) unit + (* `PATCH *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o -> a -> a -> b -> c -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (J * a * b * c * q * i * o)) * K)))) * K * a -> a ->
    Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
      Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
      option Tezos_protocol_environment_alpha__Environment.Z.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        (Tezos_protocol_environment_alpha__Environment.MBytes.t *
          Tezos_raw_protocol_alpha.Alpha_context.Gas.t)).
  
  Parameter run_operation : forall {E F H J K a b c i o q : Set},
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit
        + (* `PATCH *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> a ->
    q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
          (* `POST *) unit + (* `PATCH *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
      -> a -> a -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (F * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
            (* `POST *) unit + (* `PATCH *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o -> a -> a -> b -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (H * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
              (* `POST *) unit + (* `PATCH *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o -> a -> a -> b -> c -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (J * a * b * c * q * i * o)) * K)))) * K * a -> a ->
    Tezos_raw_protocol_alpha.Alpha_context.packed_operation *
      Tezos_protocol_environment_alpha__Environment.Chain_id.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        (Tezos_raw_protocol_alpha.Alpha_context.packed_protocol_data *
          Tezos_raw_protocol_alpha.Apply_results.packed_operation_metadata)).
  
  Parameter entrypoint_type : forall {E F H J K a b c i o q : Set},
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit
        + (* `PATCH *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> a ->
    q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
          (* `POST *) unit + (* `PATCH *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
      -> a -> a -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (F * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
            (* `POST *) unit + (* `PATCH *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o -> a -> a -> b -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (H * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
              (* `POST *) unit + (* `PATCH *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o -> a -> a -> b -> c -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (J * a * b * c * q * i * o)) * K)))) * K * a -> a ->
    Tezos_raw_protocol_alpha.Alpha_context.Script.expr * string ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        Tezos_raw_protocol_alpha.Alpha_context.Script.expr).
  
  Parameter list_entrypoints : forall {E F H J K a b c i o q : Set},
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit
        + (* `PATCH *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> a ->
    q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
          (* `POST *) unit + (* `PATCH *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
      -> a -> a -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (F * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
            (* `POST *) unit + (* `PATCH *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o -> a -> a -> b -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (H * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
              (* `POST *) unit + (* `PATCH *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o -> a -> a -> b -> c -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (J * a * b * c * q * i * o)) * K)))) * K * a -> a ->
    Tezos_raw_protocol_alpha.Alpha_context.Script.expr ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        (list (list Tezos_raw_protocol_alpha.Michelson_v1_primitives.prim) *
          list (string * Tezos_raw_protocol_alpha.Alpha_context.Script.expr))).
End Scripts.

Module Forge.
  Module Manager.
    Parameter operations : forall {E F H J K a b c i o q : Set},
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
          (* `POST *) unit + (* `PATCH *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
      a -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (E * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
            (* `POST *) unit + (* `PATCH *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i
          o -> a -> a -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (F * a * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
              (* `POST *) unit + (* `PATCH *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
              b) q i o -> a -> a -> b -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (H * a * b * q * i * o)) *
            (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
              ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
                (* `POST *) unit + (* `PATCH *) unit)
              Tezos_protocol_environment_alpha__Environment.RPC_context.t
              (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
                * b) * c) q i o -> a -> a -> b -> c -> q -> i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (J * a * b * c * q * i * o)) * K)))) * K * a -> a ->
      Tezos_protocol_environment_alpha__Environment.Block_hash.t ->
      Tezos_raw_protocol_alpha.Alpha_context.public_key_hash ->
      option Tezos_raw_protocol_alpha.Alpha_context.public_key ->
      Tezos_raw_protocol_alpha.Alpha_context.counter ->
      Tezos_raw_protocol_alpha.Alpha_context.Tez.t ->
      Tezos_protocol_environment_alpha__Environment.Z.t ->
      Tezos_protocol_environment_alpha__Environment.Z.t ->
      list Tezos_raw_protocol_alpha.Alpha_context.packed_manager_operation ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          Tezos_protocol_environment_alpha__Environment.MBytes.t).
    
    Parameter reveal : forall {E F H J K a b c i o q : Set},
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
          (* `POST *) unit + (* `PATCH *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
      a -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (E * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
            (* `POST *) unit + (* `PATCH *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i
          o -> a -> a -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (F * a * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
              (* `POST *) unit + (* `PATCH *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
              b) q i o -> a -> a -> b -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (H * a * b * q * i * o)) *
            (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
              ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
                (* `POST *) unit + (* `PATCH *) unit)
              Tezos_protocol_environment_alpha__Environment.RPC_context.t
              (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
                * b) * c) q i o -> a -> a -> b -> c -> q -> i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (J * a * b * c * q * i * o)) * K)))) * K * a -> a ->
      Tezos_protocol_environment_alpha__Environment.Block_hash.t ->
      Tezos_raw_protocol_alpha.Alpha_context.public_key_hash ->
      Tezos_raw_protocol_alpha.Alpha_context.public_key ->
      Tezos_raw_protocol_alpha.Alpha_context.counter ->
      Tezos_raw_protocol_alpha.Alpha_context.Tez.t -> unit ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          Tezos_protocol_environment_alpha__Environment.MBytes.t).
    
    Parameter transaction : forall {E F H J K a b c i o q : Set},
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
          (* `POST *) unit + (* `PATCH *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
      a -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (E * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
            (* `POST *) unit + (* `PATCH *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i
          o -> a -> a -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (F * a * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
              (* `POST *) unit + (* `PATCH *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
              b) q i o -> a -> a -> b -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (H * a * b * q * i * o)) *
            (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
              ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
                (* `POST *) unit + (* `PATCH *) unit)
              Tezos_protocol_environment_alpha__Environment.RPC_context.t
              (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
                * b) * c) q i o -> a -> a -> b -> c -> q -> i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (J * a * b * c * q * i * o)) * K)))) * K * a -> a ->
      Tezos_protocol_environment_alpha__Environment.Block_hash.t ->
      Tezos_raw_protocol_alpha.Alpha_context.public_key_hash ->
      option Tezos_raw_protocol_alpha.Alpha_context.public_key ->
      Tezos_raw_protocol_alpha.Alpha_context.counter ->
      Tezos_raw_protocol_alpha.Alpha_context.Tez.t ->
      Tezos_raw_protocol_alpha.Alpha_context.Contract.t -> option string ->
      option Tezos_raw_protocol_alpha.Alpha_context.Script.expr ->
      Tezos_protocol_environment_alpha__Environment.Z.t ->
      Tezos_protocol_environment_alpha__Environment.Z.t ->
      Tezos_raw_protocol_alpha.Alpha_context.Tez.t -> unit ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          Tezos_protocol_environment_alpha__Environment.MBytes.t).
    
    Parameter origination : forall {E F H J K a b c i o q : Set},
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
          (* `POST *) unit + (* `PATCH *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
      a -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (E * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
            (* `POST *) unit + (* `PATCH *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i
          o -> a -> a -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (F * a * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
              (* `POST *) unit + (* `PATCH *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
              b) q i o -> a -> a -> b -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (H * a * b * q * i * o)) *
            (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
              ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
                (* `POST *) unit + (* `PATCH *) unit)
              Tezos_protocol_environment_alpha__Environment.RPC_context.t
              (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
                * b) * c) q i o -> a -> a -> b -> c -> q -> i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (J * a * b * c * q * i * o)) * K)))) * K * a -> a ->
      Tezos_protocol_environment_alpha__Environment.Block_hash.t ->
      Tezos_raw_protocol_alpha.Alpha_context.public_key_hash ->
      option Tezos_raw_protocol_alpha.Alpha_context.public_key ->
      Tezos_raw_protocol_alpha.Alpha_context.counter ->
      Tezos_raw_protocol_alpha.Alpha_context.Tez.t ->
      option Tezos_raw_protocol_alpha.Alpha_context.public_key_hash ->
      Tezos_raw_protocol_alpha.Alpha_context.Script.t ->
      Tezos_protocol_environment_alpha__Environment.Z.t ->
      Tezos_protocol_environment_alpha__Environment.Z.t ->
      Tezos_raw_protocol_alpha.Alpha_context.Tez.t -> unit ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          Tezos_protocol_environment_alpha__Environment.MBytes.t).
    
    Parameter delegation : forall {E F H J K a b c i o q : Set},
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
          (* `POST *) unit + (* `PATCH *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
      a -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (E * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
            (* `POST *) unit + (* `PATCH *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i
          o -> a -> a -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (F * a * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
              (* `POST *) unit + (* `PATCH *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
              b) q i o -> a -> a -> b -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (H * a * b * q * i * o)) *
            (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
              ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
                (* `POST *) unit + (* `PATCH *) unit)
              Tezos_protocol_environment_alpha__Environment.RPC_context.t
              (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
                * b) * c) q i o -> a -> a -> b -> c -> q -> i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (J * a * b * c * q * i * o)) * K)))) * K * a -> a ->
      Tezos_protocol_environment_alpha__Environment.Block_hash.t ->
      Tezos_raw_protocol_alpha.Alpha_context.public_key_hash ->
      option Tezos_raw_protocol_alpha.Alpha_context.public_key ->
      Tezos_raw_protocol_alpha.Alpha_context.counter ->
      Tezos_raw_protocol_alpha.Alpha_context.Tez.t ->
      option Tezos_raw_protocol_alpha.Alpha_context.public_key_hash ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          Tezos_protocol_environment_alpha__Environment.MBytes.t).
  End Manager.
  
  Parameter endorsement : forall {E F H J K a b c i o q : Set},
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit
        + (* `PATCH *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> a ->
    q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
          (* `POST *) unit + (* `PATCH *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
      -> a -> a -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (F * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
            (* `POST *) unit + (* `PATCH *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o -> a -> a -> b -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (H * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
              (* `POST *) unit + (* `PATCH *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o -> a -> a -> b -> c -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (J * a * b * c * q * i * o)) * K)))) * K * a -> a ->
    Tezos_protocol_environment_alpha__Environment.Block_hash.t ->
    Tezos_raw_protocol_alpha.Alpha_context.Raw_level.t -> unit ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        Tezos_protocol_environment_alpha__Environment.MBytes.t).
  
  Parameter proposals : forall {E F H J K a b c i o q : Set},
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit
        + (* `PATCH *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> a ->
    q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
          (* `POST *) unit + (* `PATCH *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
      -> a -> a -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (F * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
            (* `POST *) unit + (* `PATCH *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o -> a -> a -> b -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (H * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
              (* `POST *) unit + (* `PATCH *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o -> a -> a -> b -> c -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (J * a * b * c * q * i * o)) * K)))) * K * a -> a ->
    Tezos_protocol_environment_alpha__Environment.Block_hash.t ->
    Tezos_raw_protocol_alpha.Alpha_context.public_key_hash ->
    Tezos_raw_protocol_alpha.Alpha_context.Voting_period.t ->
    list Tezos_protocol_environment_alpha__Environment.Protocol_hash.t ->
    unit ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        Tezos_protocol_environment_alpha__Environment.MBytes.t).
  
  Parameter ballot : forall {E F H J K a b c i o q : Set},
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit
        + (* `PATCH *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> a ->
    q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
          (* `POST *) unit + (* `PATCH *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
      -> a -> a -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (F * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
            (* `POST *) unit + (* `PATCH *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o -> a -> a -> b -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (H * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
              (* `POST *) unit + (* `PATCH *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o -> a -> a -> b -> c -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (J * a * b * c * q * i * o)) * K)))) * K * a -> a ->
    Tezos_protocol_environment_alpha__Environment.Block_hash.t ->
    Tezos_raw_protocol_alpha.Alpha_context.public_key_hash ->
    Tezos_raw_protocol_alpha.Alpha_context.Voting_period.t ->
    Tezos_protocol_environment_alpha__Environment.Protocol_hash.t ->
    Tezos_raw_protocol_alpha.Alpha_context.Vote.ballot -> unit ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        Tezos_protocol_environment_alpha__Environment.MBytes.t).
  
  Parameter seed_nonce_revelation : forall {E F H J K a b c i o q : Set},
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit
        + (* `PATCH *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> a ->
    q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
          (* `POST *) unit + (* `PATCH *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
      -> a -> a -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (F * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
            (* `POST *) unit + (* `PATCH *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o -> a -> a -> b -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (H * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
              (* `POST *) unit + (* `PATCH *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o -> a -> a -> b -> c -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (J * a * b * c * q * i * o)) * K)))) * K * a -> a ->
    Tezos_protocol_environment_alpha__Environment.Block_hash.t ->
    Tezos_raw_protocol_alpha.Alpha_context.Raw_level.t ->
    Tezos_raw_protocol_alpha.Alpha_context.Nonce.t -> unit ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        Tezos_protocol_environment_alpha__Environment.MBytes.t).
  
  Parameter double_baking_evidence : forall {E F H J K a b c i o q : Set},
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit
        + (* `PATCH *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> a ->
    q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
          (* `POST *) unit + (* `PATCH *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
      -> a -> a -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (F * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
            (* `POST *) unit + (* `PATCH *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o -> a -> a -> b -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (H * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
              (* `POST *) unit + (* `PATCH *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o -> a -> a -> b -> c -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (J * a * b * c * q * i * o)) * K)))) * K * a -> a ->
    Tezos_protocol_environment_alpha__Environment.Block_hash.t ->
    Tezos_raw_protocol_alpha.Alpha_context.Block_header.t ->
    Tezos_raw_protocol_alpha.Alpha_context.Block_header.t -> unit ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        Tezos_protocol_environment_alpha__Environment.MBytes.t).
  
  Parameter double_endorsement_evidence : forall {E F H J K a b c i o q : Set},
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit
        + (* `PATCH *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> a ->
    q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
          (* `POST *) unit + (* `PATCH *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
      -> a -> a -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (F * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
            (* `POST *) unit + (* `PATCH *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o -> a -> a -> b -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (H * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
              (* `POST *) unit + (* `PATCH *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o -> a -> a -> b -> c -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (J * a * b * c * q * i * o)) * K)))) * K * a -> a ->
    Tezos_protocol_environment_alpha__Environment.Block_hash.t ->
    Tezos_raw_protocol_alpha.Alpha_context.operation
      Tezos_raw_protocol_alpha.Alpha_context.Kind.endorsement ->
    Tezos_raw_protocol_alpha.Alpha_context.operation
      Tezos_raw_protocol_alpha.Alpha_context.Kind.endorsement -> unit ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        Tezos_protocol_environment_alpha__Environment.MBytes.t).
  
  Parameter protocol_data : forall {E F H J K a b c i o q : Set},
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit
        + (* `PATCH *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> a ->
    q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
          (* `POST *) unit + (* `PATCH *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
      -> a -> a -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (F * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
            (* `POST *) unit + (* `PATCH *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o -> a -> a -> b -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (H * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
              (* `POST *) unit + (* `PATCH *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o -> a -> a -> b -> c -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (J * a * b * c * q * i * o)) * K)))) * K * a -> a -> Z ->
    option Tezos_raw_protocol_alpha.Nonce_hash.t ->
    option Tezos_protocol_environment_alpha__Environment.MBytes.t -> unit ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        Tezos_protocol_environment_alpha__Environment.MBytes.t).
End Forge.

Module Parse.
  Parameter operations : forall {E F H J K a b c i o q : Set},
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit
        + (* `PATCH *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> a ->
    q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
          (* `POST *) unit + (* `PATCH *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
      -> a -> a -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (F * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
            (* `POST *) unit + (* `PATCH *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o -> a -> a -> b -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (H * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
              (* `POST *) unit + (* `PATCH *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o -> a -> a -> b -> c -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (J * a * b * c * q * i * o)) * K)))) * K * a -> a ->
    option bool -> list Tezos_raw_protocol_alpha.Alpha_context.Operation.raw ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        (list Tezos_raw_protocol_alpha.Alpha_context.Operation.packed)).
  
  Parameter block : forall {E F H J K a b c i o q : Set},
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit
        + (* `PATCH *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> a ->
    q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
          (* `POST *) unit + (* `PATCH *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
      -> a -> a -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (F * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
            (* `POST *) unit + (* `PATCH *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o -> a -> a -> b -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (H * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
              (* `POST *) unit + (* `PATCH *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o -> a -> a -> b -> c -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (J * a * b * c * q * i * o)) * K)))) * K * a -> a ->
    Tezos_raw_protocol_alpha.Alpha_context.Block_header.shell_header ->
    Tezos_protocol_environment_alpha__Environment.MBytes.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        Tezos_raw_protocol_alpha.Alpha_context.Block_header.protocol_data).
End Parse.

Parameter register : unit -> unit.

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

(* This is the genesis protocol: initialise the state *)
let prepare_first_block ctxt ~typecheck ~level ~timestamp ~fitness =
  Raw_context.prepare_first_block ~level ~timestamp ~fitness ctxt
  >>=? fun (previous_protocol, ctxt) ->
  Storage.Big_map.Next.init ctxt
  >>=? fun ctxt ->
  match previous_protocol with
  | Genesis param ->
      Commitment_storage.init ctxt param.commitments
      >>=? fun ctxt ->
      Roll_storage.init ctxt
      >>=? fun ctxt ->
      Seed_storage.init ctxt
      >>=? fun ctxt ->
      Contract_storage.init ctxt
      >>=? fun ctxt ->
      Bootstrap_storage.init
        ctxt
        ~typecheck
        ?ramp_up_cycles:param.security_deposit_ramp_up_cycles
        ?no_reward_cycles:param.no_reward_cycles
        param.bootstrap_accounts
        param.bootstrap_contracts
      >>=? fun ctxt ->
      Roll_storage.init_first_cycles ctxt
      >>=? fun ctxt ->
      Vote_storage.init ctxt
      >>=? fun ctxt ->
      Storage.Block_priority.init ctxt 0
      >>=? fun ctxt ->
      Vote_storage.freeze_listings ctxt >>=? fun ctxt -> return ctxt
  | Alpha_previous ->
      return ctxt

let prepare ctxt ~level ~predecessor_timestamp ~timestamp ~fitness =
  Raw_context.prepare ~level ~predecessor_timestamp ~timestamp ~fitness ctxt

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Definition prepare_first_block
  (ctxt : Tezos_protocol_environment_alpha__Environment.Context.t)
  (typecheck :
    Tezos_raw_protocol_alpha.Raw_context.t ->
    Tezos_raw_protocol_alpha.Script_repr.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        ((Tezos_raw_protocol_alpha.Script_repr.t *
          option Tezos_raw_protocol_alpha.Contract_storage.big_map_diff) *
          Tezos_raw_protocol_alpha.Raw_context.t))) (level : int32)
  (timestamp : Tezos_protocol_environment_alpha__Environment.Time.t)
  (fitness : Tezos_protocol_environment_alpha__Environment.Fitness.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  op_gtgteqquestion
    (Raw_context.prepare_first_block level timestamp fitness ctxt)
    (fun function_parameter =>
      let '(previous_protocol, ctxt) := function_parameter in
      op_gtgteqquestion (Storage.Big_map.Next.init ctxt)
        (fun ctxt =>
          match previous_protocol with
          | Tezos_raw_protocol_alpha.Raw_context.Genesis param =>
            op_gtgteqquestion
              (Commitment_storage.init ctxt
                (Tezos_raw_protocol_alpha.Parameters_repr.t.commitments param))
              (fun ctxt =>
                op_gtgteqquestion (Roll_storage.init ctxt)
                  (fun ctxt =>
                    op_gtgteqquestion (Seed_storage.init ctxt)
                      (fun ctxt =>
                        op_gtgteqquestion (Contract_storage.init ctxt)
                          (fun ctxt =>
                            op_gtgteqquestion
                              (Bootstrap_storage.init ctxt typecheck
                                (Tezos_raw_protocol_alpha.Parameters_repr.t.security_deposit_ramp_up_cycles
                                  param)
                                (Tezos_raw_protocol_alpha.Parameters_repr.t.no_reward_cycles
                                  param)
                                (Tezos_raw_protocol_alpha.Parameters_repr.t.bootstrap_accounts
                                  param)
                                (Tezos_raw_protocol_alpha.Parameters_repr.t.bootstrap_contracts
                                  param))
                              (fun ctxt =>
                                op_gtgteqquestion
                                  (Roll_storage.init_first_cycles ctxt)
                                  (fun ctxt =>
                                    op_gtgteqquestion (Vote_storage.init ctxt)
                                      (fun ctxt =>
                                        op_gtgteqquestion
                                          (Storage.Block_priority.init ctxt 0)
                                          (fun ctxt =>
                                            op_gtgteqquestion
                                              (Vote_storage.freeze_listings ctxt)
                                              (fun ctxt => __return ctxt)))))))))
          | Tezos_raw_protocol_alpha.Raw_context.Alpha_previous => __return ctxt
          end)).

Definition prepare
  (ctxt : Tezos_protocol_environment_alpha__Environment.Context.t)
  (level : Tezos_protocol_environment_alpha__Environment.Int32.t)
  (predecessor_timestamp : Tezos_protocol_environment_alpha__Environment.Time.t)
  (timestamp : Tezos_protocol_environment_alpha__Environment.Time.t)
  (fitness : Tezos_protocol_environment_alpha__Environment.Fitness.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.context) :=
  Raw_context.prepare level predecessor_timestamp timestamp fitness ctxt.

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(* Copyright (c) 2019 Nomadic Labs <contact@nomadic-labs.com>                *)
(* Copyright (c) 2019 Cryptium Labs <contact@cryptium-labs.com>              *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

let manager_script_code : Script_repr.lazy_expr =
  let open Micheline in
  let open Michelson_v1_primitives in
  Script_repr.lazy_expr @@ strip_locations
  @@ Seq
       ( 0,
         [ Prim
             ( 0,
               K_parameter,
               [ Prim
                   ( 0,
                     T_or,
                     [ Prim
                         ( 0,
                           T_lambda,
                           [ Prim (0, T_unit, [], []);
                             Prim
                               (0, T_list, [Prim (0, T_operation, [], [])], [])
                           ],
                           ["%do"] );
                       Prim (0, T_unit, [], ["%default"]) ],
                     [] ) ],
               [] );
           Prim (0, K_storage, [Prim (0, T_key_hash, [], [])], []);
           Prim
             ( 0,
               K_code,
               [ Seq
                   ( 0,
                     [ Seq
                         ( 0,
                           [ Seq
                               ( 0,
                                 [ Prim (0, I_DUP, [], []);
                                   Prim (0, I_CAR, [], []);
                                   Prim
                                     ( 0,
                                       I_DIP,
                                       [Seq (0, [Prim (0, I_CDR, [], [])])],
                                       [] ) ] ) ] );
                       Prim
                         ( 0,
                           I_IF_LEFT,
                           [ Seq
                               ( 0,
                                 [ Prim
                                     ( 0,
                                       I_PUSH,
                                       [ Prim (0, T_mutez, [], []);
                                         Int (0, Z.zero) ],
                                       [] );
                                   Prim (0, I_AMOUNT, [], []);
                                   Seq
                                     ( 0,
                                       [ Seq
                                           ( 0,
                                             [ Prim (0, I_COMPARE, [], []);
                                               Prim (0, I_EQ, [], []) ] );
                                         Prim
                                           ( 0,
                                             I_IF,
                                             [ Seq (0, []);
                                               Seq
                                                 ( 0,
                                                   [ Seq
                                                       ( 0,
                                                         [ Prim
                                                             (0, I_UNIT, [], []);
                                                           Prim
                                                             ( 0,
                                                               I_FAILWITH,
                                                               [],
                                                               [] ) ] ) ] ) ],
                                             [] ) ] );
                                   Seq
                                     ( 0,
                                       [ Prim
                                           ( 0,
                                             I_DIP,
                                             [ Seq
                                                 (0, [Prim (0, I_DUP, [], [])])
                                             ],
                                             [] );
                                         Prim (0, I_SWAP, [], []) ] );
                                   Prim (0, I_IMPLICIT_ACCOUNT, [], []);
                                   Prim (0, I_ADDRESS, [], []);
                                   Prim (0, I_SENDER, [], []);
                                   Seq
                                     ( 0,
                                       [ Seq
                                           ( 0,
                                             [ Prim (0, I_COMPARE, [], []);
                                               Prim (0, I_EQ, [], []) ] );
                                         Prim
                                           ( 0,
                                             I_IF,
                                             [ Seq (0, []);
                                               Seq
                                                 ( 0,
                                                   [ Seq
                                                       ( 0,
                                                         [ Prim
                                                             (0, I_UNIT, [], []);
                                                           Prim
                                                             ( 0,
                                                               I_FAILWITH,
                                                               [],
                                                               [] ) ] ) ] ) ],
                                             [] ) ] );
                                   Prim (0, I_UNIT, [], []);
                                   Prim (0, I_EXEC, [], []);
                                   Prim (0, I_PAIR, [], []) ] );
                             Seq
                               ( 0,
                                 [ Prim (0, I_DROP, [], []);
                                   Prim
                                     ( 0,
                                       I_NIL,
                                       [Prim (0, T_operation, [], [])],
                                       [] );
                                   Prim (0, I_PAIR, [], []) ] ) ],
                           [] ) ] ) ],
               [] ) ] )

(* Find the toplevel expression with a given prim type from list,
   because they can be in arbitrary order. *)
let find_toplevel toplevel exprs =
  let open Micheline in
  let rec iter toplevel = function
    | (Prim (_, prim, _, _) as found) :: _
      when String.equal toplevel (Michelson_v1_primitives.string_of_prim prim)
      ->
        Some found
    | _ :: rest ->
        iter toplevel rest
    | [] ->
        None
  in
  iter (Michelson_v1_primitives.string_of_prim toplevel) exprs

let add_do :
    manager_pkh:Signature.Public_key_hash.t ->
    script_code:Script_repr.lazy_expr ->
    script_storage:Script_repr.lazy_expr ->
    (Script_repr.lazy_expr * Script_repr.lazy_expr) tzresult Lwt.t =
 fun ~manager_pkh ~script_code ~script_storage ->
  let open Micheline in
  let open Michelson_v1_primitives in
  Lwt.return (Script_repr.force_decode script_code)
  >>=? fun (script_code_expr, _gas_cost) ->
  Lwt.return (Script_repr.force_decode script_storage)
  >>|? fun (script_storage_expr, _gas_cost) ->
  let storage_expr = root script_storage_expr in
  match root script_code_expr with
  | Seq (_, toplevel) -> (
    match
      ( find_toplevel K_parameter toplevel,
        find_toplevel K_storage toplevel,
        find_toplevel K_code toplevel )
    with
    | ( Some
          (Prim
            ( _,
              K_parameter,
              [Prim (_, parameter_type, parameter_expr, parameter_annot)],
              prim_param_annot )),
        Some
          (Prim
            ( _,
              K_storage,
              [ Prim
                  (_, code_storage_type, code_storage_expr, code_storage_annot)
              ],
              k_storage_annot )),
        Some (Prim (_, K_code, [code_expr], code_annot)) ) ->
        (* Note that we intentionally don't deal with potential duplicate entrypoints in this migration as there already might be some in contracts that we don't touch. *)
        let migrated_code =
          Seq
            ( 0,
              [ Prim
                  ( 0,
                    K_parameter,
                    [ Prim
                        ( 0,
                          T_or,
                          [ Prim
                              ( 0,
                                T_lambda,
                                [ Prim (0, T_unit, [], []);
                                  Prim
                                    ( 0,
                                      T_list,
                                      [Prim (0, T_operation, [], [])],
                                      [] ) ],
                                ["%do"] );
                            Prim
                              ( 0,
                                parameter_type,
                                parameter_expr,
                                "%default" :: parameter_annot ) ],
                          [] ) ],
                    prim_param_annot );
                Prim
                  ( 0,
                    K_storage,
                    [ Prim
                        ( 0,
                          T_pair,
                          [ Prim (0, T_key_hash, [], []);
                            Prim
                              ( 0,
                                code_storage_type,
                                code_storage_expr,
                                code_storage_annot ) ],
                          [] ) ],
                    k_storage_annot );
                Prim
                  ( 0,
                    K_code,
                    [ Seq
                        ( 0,
                          [ Prim (0, I_DUP, [], []);
                            Prim (0, I_CAR, [], []);
                            Prim
                              ( 0,
                                I_IF_LEFT,
                                [ Seq
                                    ( 0,
                                      [ Prim
                                          ( 0,
                                            I_PUSH,
                                            [ Prim (0, T_mutez, [], []);
                                              Int (0, Z.zero) ],
                                            [] );
                                        Prim (0, I_AMOUNT, [], []);
                                        Seq
                                          ( 0,
                                            [ Seq
                                                ( 0,
                                                  [ Prim (0, I_COMPARE, [], []);
                                                    Prim (0, I_EQ, [], []) ] );
                                              Prim
                                                ( 0,
                                                  I_IF,
                                                  [ Seq (0, []);
                                                    Seq
                                                      ( 0,
                                                        [ Seq
                                                            ( 0,
                                                              [ Prim
                                                                  ( 0,
                                                                    I_UNIT,
                                                                    [],
                                                                    [] );
                                                                Prim
                                                                  ( 0,
                                                                    I_FAILWITH,
                                                                    [],
                                                                    [] ) ] ) ]
                                                      ) ],
                                                  [] ) ] );
                                        Seq
                                          ( 0,
                                            [ Prim
                                                ( 0,
                                                  I_DIP,
                                                  [ Seq
                                                      ( 0,
                                                        [ Prim
                                                            (0, I_DUP, [], [])
                                                        ] ) ],
                                                  [] );
                                              Prim (0, I_SWAP, [], []) ] );
                                        Prim (0, I_CDR, [], []);
                                        Prim (0, I_CAR, [], []);
                                        Prim (0, I_IMPLICIT_ACCOUNT, [], []);
                                        Prim (0, I_ADDRESS, [], []);
                                        Prim (0, I_SENDER, [], []);
                                        Seq
                                          ( 0,
                                            [ Prim (0, I_COMPARE, [], []);
                                              Prim (0, I_NEQ, [], []);
                                              Prim
                                                ( 0,
                                                  I_IF,
                                                  [ Seq
                                                      ( 0,
                                                        [ Prim
                                                            ( 0,
                                                              I_SENDER,
                                                              [],
                                                              [] );
                                                          Prim
                                                            ( 0,
                                                              I_PUSH,
                                                              [ Prim
                                                                  ( 0,
                                                                    T_string,
                                                                    [],
                                                                    [] );
                                                                String
                                                                  ( 0,
                                                                    "Only the \
                                                                     owner \
                                                                     can \
                                                                     operate."
                                                                  ) ],
                                                              [] );
                                                          Prim
                                                            (0, I_PAIR, [], []);
                                                          Prim
                                                            ( 0,
                                                              I_FAILWITH,
                                                              [],
                                                              [] ) ] );
                                                    Seq
                                                      ( 0,
                                                        [ Prim
                                                            (0, I_UNIT, [], []);
                                                          Prim
                                                            (0, I_EXEC, [], []);
                                                          Prim
                                                            ( 0,
                                                              I_DIP,
                                                              [ Seq
                                                                  ( 0,
                                                                    [ Prim
                                                                        ( 0,
                                                                          I_CDR,
                                                                          [],
                                                                          [] )
                                                                    ] ) ],
                                                              [] );
                                                          Prim
                                                            (0, I_PAIR, [], [])
                                                        ] ) ],
                                                  [] ) ] ) ] );
                                  Seq
                                    ( 0,
                                      [ Prim
                                          ( 0,
                                            I_DIP,
                                            [ Seq
                                                ( 0,
                                                  [ Prim (0, I_CDR, [], []);
                                                    Prim (0, I_DUP, [], []);
                                                    Prim (0, I_CDR, [], []) ]
                                                ) ],
                                            [] );
                                        Prim (0, I_PAIR, [], []);
                                        code_expr;
                                        Prim (0, I_SWAP, [], []);
                                        Prim (0, I_CAR, [], []);
                                        Prim (0, I_SWAP, [], []);
                                        Seq
                                          ( 0,
                                            [ Seq
                                                ( 0,
                                                  [ Prim (0, I_DUP, [], []);
                                                    Prim (0, I_CAR, [], []);
                                                    Prim
                                                      ( 0,
                                                        I_DIP,
                                                        [ Seq
                                                            ( 0,
                                                              [ Prim
                                                                  ( 0,
                                                                    I_CDR,
                                                                    [],
                                                                    [] ) ] ) ],
                                                        [] ) ] ) ] );
                                        Prim
                                          ( 0,
                                            I_DIP,
                                            [ Seq
                                                ( 0,
                                                  [ Prim (0, I_SWAP, [], []);
                                                    Prim (0, I_PAIR, [], []) ]
                                                ) ],
                                            [] );
                                        Prim (0, I_PAIR, [], []) ] ) ],
                                [] ) ] ) ],
                    code_annot ) ] )
        in
        let migrated_storage =
          Prim
            ( 0,
              D_Pair,
              [ (* Instead of
                   `String (0, Signature.Public_key_hash.to_b58check manager_pkh)`
                   the storage is written as unparsed with [Optimized] *)
                Bytes
                  ( 0,
                    Data_encoding.Binary.to_bytes_exn
                      Signature.Public_key_hash.encoding
                      manager_pkh );
                storage_expr ],
              [] )
        in
        ( Script_repr.lazy_expr @@ strip_locations migrated_code,
          Script_repr.lazy_expr @@ strip_locations migrated_storage )
    | _ ->
        (script_code, script_storage) )
  | _ ->
      (script_code, script_storage)

let add_set_delegate :
    manager_pkh:Signature.Public_key_hash.t ->
    script_code:Script_repr.lazy_expr ->
    script_storage:Script_repr.lazy_expr ->
    (Script_repr.lazy_expr * Script_repr.lazy_expr) tzresult Lwt.t =
 fun ~manager_pkh ~script_code ~script_storage ->
  let open Micheline in
  let open Michelson_v1_primitives in
  Lwt.return (Script_repr.force_decode script_code)
  >>=? fun (script_code_expr, _gas_cost) ->
  Lwt.return (Script_repr.force_decode script_storage)
  >>|? fun (script_storage_expr, _gas_cost) ->
  let storage_expr = root script_storage_expr in
  match root script_code_expr with
  | Seq (_, toplevel) -> (
    match
      ( find_toplevel K_parameter toplevel,
        find_toplevel K_storage toplevel,
        find_toplevel K_code toplevel )
    with
    | ( Some
          (Prim
            ( _,
              K_parameter,
              [Prim (_, parameter_type, parameter_expr, parameter_annot)],
              prim_param_annot )),
        Some
          (Prim
            ( _,
              K_storage,
              [ Prim
                  (_, code_storage_type, code_storage_expr, code_storage_annot)
              ],
              k_storage_annot )),
        Some (Prim (_, K_code, [code_expr], code_annot)) ) ->
        (* Note that we intentionally don't deal with potential duplicate entrypoints in this migration as there already might be some in contracts that we don't touch. *)
        let migrated_code =
          Seq
            ( 0,
              [ Prim
                  ( 0,
                    K_parameter,
                    [ Prim
                        ( 0,
                          T_or,
                          [ Prim
                              ( 0,
                                T_or,
                                [ Prim (0, T_key_hash, [], ["%set_delegate"]);
                                  Prim (0, T_unit, [], ["%remove_delegate"]) ],
                                [] );
                            Prim
                              ( 0,
                                parameter_type,
                                parameter_expr,
                                "%default" :: parameter_annot ) ],
                          [] ) ],
                    prim_param_annot );
                Prim
                  ( 0,
                    K_storage,
                    [ Prim
                        ( 0,
                          T_pair,
                          [ Prim (0, T_key_hash, [], []);
                            Prim
                              ( 0,
                                code_storage_type,
                                code_storage_expr,
                                code_storage_annot ) ],
                          [] ) ],
                    k_storage_annot );
                Prim
                  ( 0,
                    K_code,
                    [ Seq
                        ( 0,
                          [ Prim (0, I_DUP, [], []);
                            Prim (0, I_CAR, [], []);
                            Prim
                              ( 0,
                                I_IF_LEFT,
                                [ Seq
                                    ( 0,
                                      [ Prim
                                          ( 0,
                                            I_PUSH,
                                            [ Prim (0, T_mutez, [], []);
                                              Int (0, Z.zero) ],
                                            [] );
                                        Prim (0, I_AMOUNT, [], []);
                                        Seq
                                          ( 0,
                                            [ Seq
                                                ( 0,
                                                  [ Prim (0, I_COMPARE, [], []);
                                                    Prim (0, I_EQ, [], []) ] );
                                              Prim
                                                ( 0,
                                                  I_IF,
                                                  [ Seq (0, []);
                                                    Seq
                                                      ( 0,
                                                        [ Seq
                                                            ( 0,
                                                              [ Prim
                                                                  ( 0,
                                                                    I_UNIT,
                                                                    [],
                                                                    [] );
                                                                Prim
                                                                  ( 0,
                                                                    I_FAILWITH,
                                                                    [],
                                                                    [] ) ] ) ]
                                                      ) ],
                                                  [] ) ] );
                                        Seq
                                          ( 0,
                                            [ Prim
                                                ( 0,
                                                  I_DIP,
                                                  [ Seq
                                                      ( 0,
                                                        [ Prim
                                                            (0, I_DUP, [], [])
                                                        ] ) ],
                                                  [] );
                                              Prim (0, I_SWAP, [], []) ] );
                                        Prim (0, I_CDR, [], []);
                                        Prim (0, I_CAR, [], []);
                                        Prim (0, I_IMPLICIT_ACCOUNT, [], []);
                                        Prim (0, I_ADDRESS, [], []);
                                        Prim (0, I_SENDER, [], []);
                                        Seq
                                          ( 0,
                                            [ Prim (0, I_COMPARE, [], []);
                                              Prim (0, I_NEQ, [], []);
                                              Prim
                                                ( 0,
                                                  I_IF,
                                                  [ Seq
                                                      ( 0,
                                                        [ Prim
                                                            ( 0,
                                                              I_SENDER,
                                                              [],
                                                              [] );
                                                          Prim
                                                            ( 0,
                                                              I_PUSH,
                                                              [ Prim
                                                                  ( 0,
                                                                    T_string,
                                                                    [],
                                                                    [] );
                                                                String
                                                                  ( 0,
                                                                    "Only the \
                                                                     owner \
                                                                     can \
                                                                     operate."
                                                                  ) ],
                                                              [] );
                                                          Prim
                                                            (0, I_PAIR, [], []);
                                                          Prim
                                                            ( 0,
                                                              I_FAILWITH,
                                                              [],
                                                              [] ) ] );
                                                    Seq
                                                      ( 0,
                                                        [ Prim
                                                            ( 0,
                                                              I_DIP,
                                                              [ Seq
                                                                  ( 0,
                                                                    [ Prim
                                                                        ( 0,
                                                                          I_CDR,
                                                                          [],
                                                                          [] );
                                                                      Prim
                                                                        ( 0,
                                                                          I_NIL,
                                                                          [ Prim
                                                                              ( 
                                                                              0,
                                                                               T_operation,
                                                                               [],
                                                                               []
                                                                              )
                                                                          ],
                                                                          [] )
                                                                    ] ) ],
                                                              [] );
                                                          Prim
                                                            ( 0,
                                                              I_IF_LEFT,
                                                              [ Seq
                                                                  ( 0,
                                                                    [ Prim
                                                                        ( 0,
                                                                          I_SOME,
                                                                          [],
                                                                          [] );
                                                                      Prim
                                                                        ( 0,
                                                                          I_SET_DELEGATE,
                                                                          [],
                                                                          [] );
                                                                      Prim
                                                                        ( 0,
                                                                          I_CONS,
                                                                          [],
                                                                          [] );
                                                                      Prim
                                                                        ( 0,
                                                                          I_PAIR,
                                                                          [],
                                                                          [] )
                                                                    ] );
                                                                Seq
                                                                  ( 0,
                                                                    [ Prim
                                                                        ( 0,
                                                                          I_DROP,
                                                                          [],
                                                                          [] );
                                                                      Prim
                                                                        ( 0,
                                                                          I_NONE,
                                                                          [ Prim
                                                                              ( 
                                                                              0,
                                                                               T_key_hash,
                                                                               [],
                                                                               []
                                                                              )
                                                                          ],
                                                                          [] );
                                                                      Prim
                                                                        ( 0,
                                                                          I_SET_DELEGATE,
                                                                          [],
                                                                          [] );
                                                                      Prim
                                                                        ( 0,
                                                                          I_CONS,
                                                                          [],
                                                                          [] );
                                                                      Prim
                                                                        ( 0,
                                                                          I_PAIR,
                                                                          [],
                                                                          [] )
                                                                    ] ) ],
                                                              [] ) ] ) ],
                                                  [] ) ] ) ] );
                                  Seq
                                    ( 0,
                                      [ Prim
                                          ( 0,
                                            I_DIP,
                                            [ Seq
                                                ( 0,
                                                  [ Prim (0, I_CDR, [], []);
                                                    Prim (0, I_DUP, [], []);
                                                    Prim (0, I_CDR, [], []) ]
                                                ) ],
                                            [] );
                                        Prim (0, I_PAIR, [], []);
                                        code_expr;
                                        Prim (0, I_SWAP, [], []);
                                        Prim (0, I_CAR, [], []);
                                        Prim (0, I_SWAP, [], []);
                                        Seq
                                          ( 0,
                                            [ Seq
                                                ( 0,
                                                  [ Prim (0, I_DUP, [], []);
                                                    Prim (0, I_CAR, [], []);
                                                    Prim
                                                      ( 0,
                                                        I_DIP,
                                                        [ Seq
                                                            ( 0,
                                                              [ Prim
                                                                  ( 0,
                                                                    I_CDR,
                                                                    [],
                                                                    [] ) ] ) ],
                                                        [] ) ] ) ] );
                                        Prim
                                          ( 0,
                                            I_DIP,
                                            [ Seq
                                                ( 0,
                                                  [ Prim (0, I_SWAP, [], []);
                                                    Prim (0, I_PAIR, [], []) ]
                                                ) ],
                                            [] );
                                        Prim (0, I_PAIR, [], []) ] ) ],
                                [] ) ] ) ],
                    code_annot ) ] )
        in
        let migrated_storage =
          Prim
            ( 0,
              D_Pair,
              [ (* Instead of
                   `String (0, Signature.Public_key_hash.to_b58check manager_pkh)`
                   the storage is written as unparsed with [Optimized] *)
                Bytes
                  ( 0,
                    Data_encoding.Binary.to_bytes_exn
                      Signature.Public_key_hash.encoding
                      manager_pkh );
                storage_expr ],
              [] )
        in
        ( Script_repr.lazy_expr @@ strip_locations migrated_code,
          Script_repr.lazy_expr @@ strip_locations migrated_storage )
    | _ ->
        (script_code, script_storage) )
  | _ ->
      (script_code, script_storage)

let has_default_entrypoint expr =
  let open Micheline in
  let open Michelson_v1_primitives in
  match Script_repr.force_decode expr with
  | Error _ ->
      false
  | Ok (expr, _) -> (
    match root expr with
    | Seq (_, toplevel) -> (
      match find_toplevel K_parameter toplevel with
      | Some (Prim (_, K_parameter, [_], ["%default"])) ->
          false
      | Some (Prim (_, K_parameter, [parameter_expr], _)) ->
          let rec has_default = function
            | Prim (_, T_or, [l; r], annots) ->
                List.exists (String.equal "%default") annots
                || has_default l || has_default r
            | Prim (_, _, _, annots) ->
                List.exists (String.equal "%default") annots
            | _ ->
                false
          in
          has_default parameter_expr
      | Some _ | None ->
          false )
    | _ ->
        false )

let add_root_entrypoint :
    script_code:Script_repr.lazy_expr -> Script_repr.lazy_expr tzresult Lwt.t =
 fun ~script_code ->
  let open Micheline in
  let open Michelson_v1_primitives in
  Lwt.return (Script_repr.force_decode script_code)
  >>|? fun (script_code_expr, _gas_cost) ->
  match root script_code_expr with
  | Seq (_, toplevel) ->
      let migrated_code =
        Seq
          ( 0,
            List.map
              (function
                | Prim (_, K_parameter, [parameter_expr], _) ->
                    Prim (0, K_parameter, [parameter_expr], ["%root"])
                | Prim (_, K_code, exprs, annots) ->
                    let rec rewrite_self = function
                      | ( Int _
                        | String _
                        | Bytes _
                        | Prim (_, I_CREATE_CONTRACT, _, _) ) as leaf ->
                          leaf
                      | Prim (_, I_SELF, [], annots) ->
                          Prim (0, I_SELF, [], "%root" :: annots)
                      | Prim (_, name, args, annots) ->
                          Prim (0, name, List.map rewrite_self args, annots)
                      | Seq (_, args) ->
                          Seq (0, List.map rewrite_self args)
                    in
                    Prim (0, K_code, List.map rewrite_self exprs, annots)
                | other ->
                    other)
              toplevel )
      in
      Script_repr.lazy_expr @@ strip_locations migrated_code
  | _ ->
      script_code

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Definition manager_script_code
  : Tezos_raw_protocol_alpha.Script_repr.lazy_expr :=
  op_atat Script_repr.lazy_expr
    (op_atat strip_locations
      (Tezos_protocol_environment_alpha__Environment.Micheline.Seq 0
        (cons
          (Tezos_protocol_environment_alpha__Environment.Micheline.Prim 0
            Tezos_raw_protocol_alpha.Michelson_v1_primitives.K_parameter
            (cons
              (Tezos_protocol_environment_alpha__Environment.Micheline.Prim 0
                Tezos_raw_protocol_alpha.Michelson_v1_primitives.T_or
                (cons
                  (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                    0 Tezos_raw_protocol_alpha.Michelson_v1_primitives.T_lambda
                    (cons
                      (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                        0
                        Tezos_raw_protocol_alpha.Michelson_v1_primitives.T_unit
                        [] [])
                      (cons
                        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                          0
                          Tezos_raw_protocol_alpha.Michelson_v1_primitives.T_list
                          (cons
                            (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                              0
                              Tezos_raw_protocol_alpha.Michelson_v1_primitives.T_operation
                              [] []) []) []) [])) (cons "%do" % string []))
                  (cons
                    (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                      0 Tezos_raw_protocol_alpha.Michelson_v1_primitives.T_unit
                      [] (cons "%default" % string [])) [])) []) []) [])
          (cons
            (Tezos_protocol_environment_alpha__Environment.Micheline.Prim 0
              Tezos_raw_protocol_alpha.Michelson_v1_primitives.K_storage
              (cons
                (Tezos_protocol_environment_alpha__Environment.Micheline.Prim 0
                  Tezos_raw_protocol_alpha.Michelson_v1_primitives.T_key_hash []
                  []) []) [])
            (cons
              (Tezos_protocol_environment_alpha__Environment.Micheline.Prim 0
                Tezos_raw_protocol_alpha.Michelson_v1_primitives.K_code
                (cons
                  (Tezos_protocol_environment_alpha__Environment.Micheline.Seq 0
                    (cons
                      (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                        0
                        (cons
                          (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                            0
                            (cons
                              (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                0
                                Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_DUP
                                [] [])
                              (cons
                                (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                  0
                                  Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_CAR
                                  [] [])
                                (cons
                                  (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                    0
                                    Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_DIP
                                    (cons
                                      (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                        0
                                        (cons
                                          (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                            0
                                            Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_CDR
                                            [] []) [])) []) []) [])))) []))
                      (cons
                        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                          0
                          Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_IF_LEFT
                          (cons
                            (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                              0
                              (cons
                                (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                  0
                                  Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_PUSH
                                  (cons
                                    (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                      0
                                      Tezos_raw_protocol_alpha.Michelson_v1_primitives.T_mutez
                                      [] [])
                                    (cons
                                      (Tezos_protocol_environment_alpha__Environment.Micheline.Int
                                        0 Z.zero) [])) [])
                                (cons
                                  (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                    0
                                    Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_AMOUNT
                                    [] [])
                                  (cons
                                    (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                      0
                                      (cons
                                        (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                          0
                                          (cons
                                            (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                              0
                                              Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_COMPARE
                                              [] [])
                                            (cons
                                              (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                0
                                                Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_EQ
                                                [] []) [])))
                                        (cons
                                          (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                            0
                                            Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_IF
                                            (cons
                                              (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                0 [])
                                              (cons
                                                (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                  0
                                                  (cons
                                                    (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                      0
                                                      (cons
                                                        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                          0
                                                          Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_UNIT
                                                          [] [])
                                                        (cons
                                                          (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                            0
                                                            Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_FAILWITH
                                                            [] []) []))) [])) []))
                                            []) [])))
                                    (cons
                                      (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                        0
                                        (cons
                                          (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                            0
                                            Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_DIP
                                            (cons
                                              (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                0
                                                (cons
                                                  (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                    0
                                                    Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_DUP
                                                    [] []) [])) []) [])
                                          (cons
                                            (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                              0
                                              Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_SWAP
                                              [] []) [])))
                                      (cons
                                        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                          0
                                          Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_IMPLICIT_ACCOUNT
                                          [] [])
                                        (cons
                                          (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                            0
                                            Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_ADDRESS
                                            [] [])
                                          (cons
                                            (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                              0
                                              Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_SENDER
                                              [] [])
                                            (cons
                                              (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                0
                                                (cons
                                                  (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                    0
                                                    (cons
                                                      (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                        0
                                                        Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_COMPARE
                                                        [] [])
                                                      (cons
                                                        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                          0
                                                          Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_EQ
                                                          [] []) [])))
                                                  (cons
                                                    (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                      0
                                                      Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_IF
                                                      (cons
                                                        (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                          0 [])
                                                        (cons
                                                          (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                            0
                                                            (cons
                                                              (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                                0
                                                                (cons
                                                                  (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                    0
                                                                    Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_UNIT
                                                                    [] [])
                                                                  (cons
                                                                    (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                      0
                                                                      Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_FAILWITH
                                                                      [] []) [])))
                                                              [])) [])) []) [])))
                                              (cons
                                                (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                  0
                                                  Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_UNIT
                                                  [] [])
                                                (cons
                                                  (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                    0
                                                    Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_EXEC
                                                    [] [])
                                                  (cons
                                                    (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                      0
                                                      Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_PAIR
                                                      [] []) []))))))))))))
                            (cons
                              (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                0
                                (cons
                                  (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                    0
                                    Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_DROP
                                    [] [])
                                  (cons
                                    (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                      0
                                      Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_NIL
                                      (cons
                                        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                          0
                                          Tezos_raw_protocol_alpha.Michelson_v1_primitives.T_operation
                                          [] []) []) [])
                                    (cons
                                      (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                        0
                                        Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_PAIR
                                        [] []) [])))) [])) []) []))) []) []) []))))).

Definition find_toplevel {A : Set}
  (toplevel : Tezos_raw_protocol_alpha.Michelson_v1_primitives.prim)
  (exprs :
    list
      (Tezos_protocol_environment_alpha__Environment.Micheline.node A
        Tezos_raw_protocol_alpha.Michelson_v1_primitives.prim))
  : option
    (Tezos_protocol_environment_alpha__Environment.Micheline.node A
      Tezos_raw_protocol_alpha.Michelson_v1_primitives.prim) :=
  let fix iter {B : Set}
    (toplevel : Tezos_protocol_environment_alpha__Environment.String.t)
    (function_parameter :
    list
      (Tezos_protocol_environment_alpha__Environment.Micheline.node B
        Tezos_raw_protocol_alpha.Michelson_v1_primitives.prim))
    : option
      (Tezos_protocol_environment_alpha__Environment.Micheline.node B
        Tezos_raw_protocol_alpha.Michelson_v1_primitives.prim) :=
    match function_parameter with
    |
      cons
        ((Tezos_protocol_environment_alpha__Environment.Micheline.Prim _ prim _
          _) as found) _ => Some found
    | cons _ rest => iter toplevel rest
    | [] => None
    end in
  iter (Michelson_v1_primitives.string_of_prim toplevel) exprs.

Definition add_do
  (manager_pkh :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  (script_code : Tezos_raw_protocol_alpha.Script_repr.lazy_expr)
  (script_storage : Tezos_raw_protocol_alpha.Script_repr.lazy_expr)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Script_repr.lazy_expr *
        Tezos_raw_protocol_alpha.Script_repr.lazy_expr)) :=
  op_gtgteqquestion (Lwt.__return (Script_repr.force_decode script_code))
    (fun function_parameter =>
      let '(script_code_expr, _gas_cost) := function_parameter in
      op_gtgtpipequestion
        (Lwt.__return (Script_repr.force_decode script_storage))
        (fun function_parameter =>
          let '(script_storage_expr, _gas_cost) := function_parameter in
          let storage_expr := root script_storage_expr in
          match root script_code_expr with
          |
            Tezos_protocol_environment_alpha__Environment.Micheline.Seq _
              toplevel =>
            match
              ((find_toplevel
                Tezos_raw_protocol_alpha.Michelson_v1_primitives.K_parameter
                toplevel),
                (find_toplevel
                  Tezos_raw_protocol_alpha.Michelson_v1_primitives.K_storage
                  toplevel),
                (find_toplevel
                  Tezos_raw_protocol_alpha.Michelson_v1_primitives.K_code
                  toplevel)) with
            |
              (Some
                (Tezos_protocol_environment_alpha__Environment.Micheline.Prim _
                  Tezos_raw_protocol_alpha.Michelson_v1_primitives.K_parameter
                  (cons
                    (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                      _ parameter_type parameter_expr parameter_annot) [])
                  prim_param_annot),
                Some
                  (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                    _ Tezos_raw_protocol_alpha.Michelson_v1_primitives.K_storage
                    (cons
                      (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                        _ code_storage_type code_storage_expr code_storage_annot)
                      []) k_storage_annot),
                Some
                  (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                    _ Tezos_raw_protocol_alpha.Michelson_v1_primitives.K_code
                    (cons code_expr []) code_annot)) =>
              let migrated_code :=
                Tezos_protocol_environment_alpha__Environment.Micheline.Seq 0
                  (cons
                    (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                      0
                      Tezos_raw_protocol_alpha.Michelson_v1_primitives.K_parameter
                      (cons
                        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                          0
                          Tezos_raw_protocol_alpha.Michelson_v1_primitives.T_or
                          (cons
                            (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                              0
                              Tezos_raw_protocol_alpha.Michelson_v1_primitives.T_lambda
                              (cons
                                (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                  0
                                  Tezos_raw_protocol_alpha.Michelson_v1_primitives.T_unit
                                  [] [])
                                (cons
                                  (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                    0
                                    Tezos_raw_protocol_alpha.Michelson_v1_primitives.T_list
                                    (cons
                                      (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                        0
                                        Tezos_raw_protocol_alpha.Michelson_v1_primitives.T_operation
                                        [] []) []) []) []))
                              (cons "%do" % string []))
                            (cons
                              (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                0 parameter_type parameter_expr
                                (cons "%default" % string parameter_annot)) []))
                          []) []) prim_param_annot)
                    (cons
                      (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                        0
                        Tezos_raw_protocol_alpha.Michelson_v1_primitives.K_storage
                        (cons
                          (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                            0
                            Tezos_raw_protocol_alpha.Michelson_v1_primitives.T_pair
                            (cons
                              (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                0
                                Tezos_raw_protocol_alpha.Michelson_v1_primitives.T_key_hash
                                [] [])
                              (cons
                                (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                  0 code_storage_type code_storage_expr
                                  code_storage_annot) [])) []) [])
                        k_storage_annot)
                      (cons
                        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                          0
                          Tezos_raw_protocol_alpha.Michelson_v1_primitives.K_code
                          (cons
                            (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                              0
                              (cons
                                (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                  0
                                  Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_DUP
                                  [] [])
                                (cons
                                  (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                    0
                                    Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_CAR
                                    [] [])
                                  (cons
                                    (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                      0
                                      Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_IF_LEFT
                                      (cons
                                        (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                          0
                                          (cons
                                            (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                              0
                                              Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_PUSH
                                              (cons
                                                (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                  0
                                                  Tezos_raw_protocol_alpha.Michelson_v1_primitives.T_mutez
                                                  [] [])
                                                (cons
                                                  (Tezos_protocol_environment_alpha__Environment.Micheline.Int
                                                    0 Z.zero) [])) [])
                                            (cons
                                              (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                0
                                                Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_AMOUNT
                                                [] [])
                                              (cons
                                                (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                  0
                                                  (cons
                                                    (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                      0
                                                      (cons
                                                        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                          0
                                                          Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_COMPARE
                                                          [] [])
                                                        (cons
                                                          (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                            0
                                                            Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_EQ
                                                            [] []) [])))
                                                    (cons
                                                      (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                        0
                                                        Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_IF
                                                        (cons
                                                          (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                            0 [])
                                                          (cons
                                                            (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                              0
                                                              (cons
                                                                (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                                  0
                                                                  (cons
                                                                    (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                      0
                                                                      Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_UNIT
                                                                      [] [])
                                                                    (cons
                                                                      (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                        0
                                                                        Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_FAILWITH
                                                                        [] [])
                                                                      []))) []))
                                                            [])) []) [])))
                                                (cons
                                                  (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                    0
                                                    (cons
                                                      (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                        0
                                                        Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_DIP
                                                        (cons
                                                          (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                            0
                                                            (cons
                                                              (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                0
                                                                Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_DUP
                                                                [] []) [])) [])
                                                        [])
                                                      (cons
                                                        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                          0
                                                          Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_SWAP
                                                          [] []) [])))
                                                  (cons
                                                    (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                      0
                                                      Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_CDR
                                                      [] [])
                                                    (cons
                                                      (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                        0
                                                        Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_CAR
                                                        [] [])
                                                      (cons
                                                        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                          0
                                                          Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_IMPLICIT_ACCOUNT
                                                          [] [])
                                                        (cons
                                                          (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                            0
                                                            Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_ADDRESS
                                                            [] [])
                                                          (cons
                                                            (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                              0
                                                              Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_SENDER
                                                              [] [])
                                                            (cons
                                                              (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                                0
                                                                (cons
                                                                  (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                    0
                                                                    Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_COMPARE
                                                                    [] [])
                                                                  (cons
                                                                    (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                      0
                                                                      Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_NEQ
                                                                      [] [])
                                                                    (cons
                                                                      (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                        0
                                                                        Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_IF
                                                                        (cons
                                                                          (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                                            0
                                                                            (cons
                                                                              (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                                0
                                                                                Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_SENDER
                                                                                []
                                                                                [])
                                                                              (cons
                                                                                (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                                  0
                                                                                  Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_PUSH
                                                                                  (cons
                                                                                    (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                                      0
                                                                                      Tezos_raw_protocol_alpha.Michelson_v1_primitives.T_string
                                                                                      []
                                                                                      [])
                                                                                    (cons
                                                                                      (Tezos_protocol_environment_alpha__Environment.Micheline.String
                                                                                        0
                                                                                        "Only the owner can operate."
                                                                                          %
                                                                                          string)
                                                                                      []))
                                                                                  [])
                                                                                (cons
                                                                                  (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                                    0
                                                                                    Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_PAIR
                                                                                    []
                                                                                    [])
                                                                                  (cons
                                                                                    (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                                      0
                                                                                      Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_FAILWITH
                                                                                      []
                                                                                      [])
                                                                                    [])))))
                                                                          (cons
                                                                            (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                                              0
                                                                              (cons
                                                                                (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                                  0
                                                                                  Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_UNIT
                                                                                  []
                                                                                  [])
                                                                                (cons
                                                                                  (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                                    0
                                                                                    Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_EXEC
                                                                                    []
                                                                                    [])
                                                                                  (cons
                                                                                    (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                                      0
                                                                                      Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_DIP
                                                                                      (cons
                                                                                        (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                                                          0
                                                                                          (cons
                                                                                            (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                                              0
                                                                                              Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_CDR
                                                                                              []
                                                                                              [])
                                                                                            []))
                                                                                        [])
                                                                                      [])
                                                                                    (cons
                                                                                      (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                                        0
                                                                                        Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_PAIR
                                                                                        []
                                                                                        [])
                                                                                      [])))))
                                                                            []))
                                                                        []) []))))
                                                              [])))))))))))
                                        (cons
                                          (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                            0
                                            (cons
                                              (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                0
                                                Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_DIP
                                                (cons
                                                  (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                    0
                                                    (cons
                                                      (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                        0
                                                        Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_CDR
                                                        [] [])
                                                      (cons
                                                        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                          0
                                                          Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_DUP
                                                          [] [])
                                                        (cons
                                                          (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                            0
                                                            Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_CDR
                                                            [] []) [])))) []) [])
                                              (cons
                                                (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                  0
                                                  Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_PAIR
                                                  [] [])
                                                (cons code_expr
                                                  (cons
                                                    (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                      0
                                                      Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_SWAP
                                                      [] [])
                                                    (cons
                                                      (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                        0
                                                        Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_CAR
                                                        [] [])
                                                      (cons
                                                        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                          0
                                                          Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_SWAP
                                                          [] [])
                                                        (cons
                                                          (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                            0
                                                            (cons
                                                              (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                                0
                                                                (cons
                                                                  (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                    0
                                                                    Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_DUP
                                                                    [] [])
                                                                  (cons
                                                                    (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                      0
                                                                      Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_CAR
                                                                      [] [])
                                                                    (cons
                                                                      (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                        0
                                                                        Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_DIP
                                                                        (cons
                                                                          (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                                            0
                                                                            (cons
                                                                              (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                                0
                                                                                Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_CDR
                                                                                []
                                                                                [])
                                                                              []))
                                                                          []) [])
                                                                      [])))) []))
                                                          (cons
                                                            (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                              0
                                                              Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_DIP
                                                              (cons
                                                                (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                                  0
                                                                  (cons
                                                                    (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                      0
                                                                      Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_SWAP
                                                                      [] [])
                                                                    (cons
                                                                      (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                        0
                                                                        Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_PAIR
                                                                        [] [])
                                                                      []))) [])
                                                              [])
                                                            (cons
                                                              (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                0
                                                                Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_PAIR
                                                                [] []) []))))))))))
                                          [])) []) [])))) []) code_annot) [])))
                in
              let migrated_storage :=
                Tezos_protocol_environment_alpha__Environment.Micheline.Prim 0
                  Tezos_raw_protocol_alpha.Michelson_v1_primitives.D_Pair
                  (cons
                    (Tezos_protocol_environment_alpha__Environment.Micheline.Bytes
                      0
                      (Data_encoding.Binary.to_bytes_exn
                        Signature.Public_key_hash.encoding manager_pkh))
                    (cons storage_expr [])) [] in
              ((op_atat Script_repr.lazy_expr (strip_locations migrated_code)),
                (op_atat Script_repr.lazy_expr
                  (strip_locations migrated_storage)))
            | _ => (script_code, script_storage)
            end
          | _ => (script_code, script_storage)
          end)).

Definition add_set_delegate
  (manager_pkh :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  (script_code : Tezos_raw_protocol_alpha.Script_repr.lazy_expr)
  (script_storage : Tezos_raw_protocol_alpha.Script_repr.lazy_expr)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Script_repr.lazy_expr *
        Tezos_raw_protocol_alpha.Script_repr.lazy_expr)) :=
  op_gtgteqquestion (Lwt.__return (Script_repr.force_decode script_code))
    (fun function_parameter =>
      let '(script_code_expr, _gas_cost) := function_parameter in
      op_gtgtpipequestion
        (Lwt.__return (Script_repr.force_decode script_storage))
        (fun function_parameter =>
          let '(script_storage_expr, _gas_cost) := function_parameter in
          let storage_expr := root script_storage_expr in
          match root script_code_expr with
          |
            Tezos_protocol_environment_alpha__Environment.Micheline.Seq _
              toplevel =>
            match
              ((find_toplevel
                Tezos_raw_protocol_alpha.Michelson_v1_primitives.K_parameter
                toplevel),
                (find_toplevel
                  Tezos_raw_protocol_alpha.Michelson_v1_primitives.K_storage
                  toplevel),
                (find_toplevel
                  Tezos_raw_protocol_alpha.Michelson_v1_primitives.K_code
                  toplevel)) with
            |
              (Some
                (Tezos_protocol_environment_alpha__Environment.Micheline.Prim _
                  Tezos_raw_protocol_alpha.Michelson_v1_primitives.K_parameter
                  (cons
                    (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                      _ parameter_type parameter_expr parameter_annot) [])
                  prim_param_annot),
                Some
                  (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                    _ Tezos_raw_protocol_alpha.Michelson_v1_primitives.K_storage
                    (cons
                      (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                        _ code_storage_type code_storage_expr code_storage_annot)
                      []) k_storage_annot),
                Some
                  (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                    _ Tezos_raw_protocol_alpha.Michelson_v1_primitives.K_code
                    (cons code_expr []) code_annot)) =>
              let migrated_code :=
                Tezos_protocol_environment_alpha__Environment.Micheline.Seq 0
                  (cons
                    (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                      0
                      Tezos_raw_protocol_alpha.Michelson_v1_primitives.K_parameter
                      (cons
                        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                          0
                          Tezos_raw_protocol_alpha.Michelson_v1_primitives.T_or
                          (cons
                            (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                              0
                              Tezos_raw_protocol_alpha.Michelson_v1_primitives.T_or
                              (cons
                                (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                  0
                                  Tezos_raw_protocol_alpha.Michelson_v1_primitives.T_key_hash
                                  [] (cons "%set_delegate" % string []))
                                (cons
                                  (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                    0
                                    Tezos_raw_protocol_alpha.Michelson_v1_primitives.T_unit
                                    [] (cons "%remove_delegate" % string [])) []))
                              [])
                            (cons
                              (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                0 parameter_type parameter_expr
                                (cons "%default" % string parameter_annot)) []))
                          []) []) prim_param_annot)
                    (cons
                      (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                        0
                        Tezos_raw_protocol_alpha.Michelson_v1_primitives.K_storage
                        (cons
                          (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                            0
                            Tezos_raw_protocol_alpha.Michelson_v1_primitives.T_pair
                            (cons
                              (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                0
                                Tezos_raw_protocol_alpha.Michelson_v1_primitives.T_key_hash
                                [] [])
                              (cons
                                (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                  0 code_storage_type code_storage_expr
                                  code_storage_annot) [])) []) [])
                        k_storage_annot)
                      (cons
                        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                          0
                          Tezos_raw_protocol_alpha.Michelson_v1_primitives.K_code
                          (cons
                            (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                              0
                              (cons
                                (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                  0
                                  Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_DUP
                                  [] [])
                                (cons
                                  (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                    0
                                    Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_CAR
                                    [] [])
                                  (cons
                                    (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                      0
                                      Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_IF_LEFT
                                      (cons
                                        (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                          0
                                          (cons
                                            (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                              0
                                              Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_PUSH
                                              (cons
                                                (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                  0
                                                  Tezos_raw_protocol_alpha.Michelson_v1_primitives.T_mutez
                                                  [] [])
                                                (cons
                                                  (Tezos_protocol_environment_alpha__Environment.Micheline.Int
                                                    0 Z.zero) [])) [])
                                            (cons
                                              (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                0
                                                Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_AMOUNT
                                                [] [])
                                              (cons
                                                (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                  0
                                                  (cons
                                                    (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                      0
                                                      (cons
                                                        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                          0
                                                          Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_COMPARE
                                                          [] [])
                                                        (cons
                                                          (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                            0
                                                            Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_EQ
                                                            [] []) [])))
                                                    (cons
                                                      (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                        0
                                                        Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_IF
                                                        (cons
                                                          (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                            0 [])
                                                          (cons
                                                            (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                              0
                                                              (cons
                                                                (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                                  0
                                                                  (cons
                                                                    (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                      0
                                                                      Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_UNIT
                                                                      [] [])
                                                                    (cons
                                                                      (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                        0
                                                                        Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_FAILWITH
                                                                        [] [])
                                                                      []))) []))
                                                            [])) []) [])))
                                                (cons
                                                  (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                    0
                                                    (cons
                                                      (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                        0
                                                        Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_DIP
                                                        (cons
                                                          (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                            0
                                                            (cons
                                                              (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                0
                                                                Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_DUP
                                                                [] []) [])) [])
                                                        [])
                                                      (cons
                                                        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                          0
                                                          Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_SWAP
                                                          [] []) [])))
                                                  (cons
                                                    (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                      0
                                                      Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_CDR
                                                      [] [])
                                                    (cons
                                                      (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                        0
                                                        Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_CAR
                                                        [] [])
                                                      (cons
                                                        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                          0
                                                          Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_IMPLICIT_ACCOUNT
                                                          [] [])
                                                        (cons
                                                          (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                            0
                                                            Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_ADDRESS
                                                            [] [])
                                                          (cons
                                                            (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                              0
                                                              Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_SENDER
                                                              [] [])
                                                            (cons
                                                              (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                                0
                                                                (cons
                                                                  (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                    0
                                                                    Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_COMPARE
                                                                    [] [])
                                                                  (cons
                                                                    (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                      0
                                                                      Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_NEQ
                                                                      [] [])
                                                                    (cons
                                                                      (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                        0
                                                                        Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_IF
                                                                        (cons
                                                                          (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                                            0
                                                                            (cons
                                                                              (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                                0
                                                                                Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_SENDER
                                                                                []
                                                                                [])
                                                                              (cons
                                                                                (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                                  0
                                                                                  Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_PUSH
                                                                                  (cons
                                                                                    (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                                      0
                                                                                      Tezos_raw_protocol_alpha.Michelson_v1_primitives.T_string
                                                                                      []
                                                                                      [])
                                                                                    (cons
                                                                                      (Tezos_protocol_environment_alpha__Environment.Micheline.String
                                                                                        0
                                                                                        "Only the owner can operate."
                                                                                          %
                                                                                          string)
                                                                                      []))
                                                                                  [])
                                                                                (cons
                                                                                  (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                                    0
                                                                                    Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_PAIR
                                                                                    []
                                                                                    [])
                                                                                  (cons
                                                                                    (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                                      0
                                                                                      Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_FAILWITH
                                                                                      []
                                                                                      [])
                                                                                    [])))))
                                                                          (cons
                                                                            (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                                              0
                                                                              (cons
                                                                                (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                                  0
                                                                                  Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_DIP
                                                                                  (cons
                                                                                    (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                                                      0
                                                                                      (cons
                                                                                        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                                          0
                                                                                          Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_CDR
                                                                                          []
                                                                                          [])
                                                                                        (cons
                                                                                          (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                                            0
                                                                                            Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_NIL
                                                                                            (cons
                                                                                              (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                                                0
                                                                                                Tezos_raw_protocol_alpha.Michelson_v1_primitives.T_operation
                                                                                                []
                                                                                                [])
                                                                                              [])
                                                                                            [])
                                                                                          [])))
                                                                                    [])
                                                                                  [])
                                                                                (cons
                                                                                  (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                                    0
                                                                                    Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_IF_LEFT
                                                                                    (cons
                                                                                      (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                                                        0
                                                                                        (cons
                                                                                          (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                                            0
                                                                                            Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_SOME
                                                                                            []
                                                                                            [])
                                                                                          (cons
                                                                                            (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                                              0
                                                                                              Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_SET_DELEGATE
                                                                                              []
                                                                                              [])
                                                                                            (cons
                                                                                              (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                                                0
                                                                                                Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_CONS
                                                                                                []
                                                                                                [])
                                                                                              (cons
                                                                                                (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                                                  0
                                                                                                  Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_PAIR
                                                                                                  []
                                                                                                  [])
                                                                                                [])))))
                                                                                      (cons
                                                                                        (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                                                          0
                                                                                          (cons
                                                                                            (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                                              0
                                                                                              Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_DROP
                                                                                              []
                                                                                              [])
                                                                                            (cons
                                                                                              (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                                                0
                                                                                                Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_NONE
                                                                                                (cons
                                                                                                  (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                                                    0
                                                                                                    Tezos_raw_protocol_alpha.Michelson_v1_primitives.T_key_hash
                                                                                                    []
                                                                                                    [])
                                                                                                  [])
                                                                                                [])
                                                                                              (cons
                                                                                                (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                                                  0
                                                                                                  Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_SET_DELEGATE
                                                                                                  []
                                                                                                  [])
                                                                                                (cons
                                                                                                  (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                                                    0
                                                                                                    Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_CONS
                                                                                                    []
                                                                                                    [])
                                                                                                  (cons
                                                                                                    (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                                                      0
                                                                                                      Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_PAIR
                                                                                                      []
                                                                                                      [])
                                                                                                    []))))))
                                                                                        []))
                                                                                    [])
                                                                                  [])))
                                                                            []))
                                                                        []) []))))
                                                              [])))))))))))
                                        (cons
                                          (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                            0
                                            (cons
                                              (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                0
                                                Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_DIP
                                                (cons
                                                  (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                    0
                                                    (cons
                                                      (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                        0
                                                        Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_CDR
                                                        [] [])
                                                      (cons
                                                        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                          0
                                                          Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_DUP
                                                          [] [])
                                                        (cons
                                                          (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                            0
                                                            Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_CDR
                                                            [] []) [])))) []) [])
                                              (cons
                                                (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                  0
                                                  Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_PAIR
                                                  [] [])
                                                (cons code_expr
                                                  (cons
                                                    (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                      0
                                                      Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_SWAP
                                                      [] [])
                                                    (cons
                                                      (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                        0
                                                        Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_CAR
                                                        [] [])
                                                      (cons
                                                        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                          0
                                                          Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_SWAP
                                                          [] [])
                                                        (cons
                                                          (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                            0
                                                            (cons
                                                              (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                                0
                                                                (cons
                                                                  (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                    0
                                                                    Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_DUP
                                                                    [] [])
                                                                  (cons
                                                                    (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                      0
                                                                      Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_CAR
                                                                      [] [])
                                                                    (cons
                                                                      (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                        0
                                                                        Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_DIP
                                                                        (cons
                                                                          (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                                            0
                                                                            (cons
                                                                              (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                                0
                                                                                Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_CDR
                                                                                []
                                                                                [])
                                                                              []))
                                                                          []) [])
                                                                      [])))) []))
                                                          (cons
                                                            (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                              0
                                                              Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_DIP
                                                              (cons
                                                                (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                                  0
                                                                  (cons
                                                                    (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                      0
                                                                      Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_SWAP
                                                                      [] [])
                                                                    (cons
                                                                      (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                        0
                                                                        Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_PAIR
                                                                        [] [])
                                                                      []))) [])
                                                              [])
                                                            (cons
                                                              (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                0
                                                                Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_PAIR
                                                                [] []) []))))))))))
                                          [])) []) [])))) []) code_annot) [])))
                in
              let migrated_storage :=
                Tezos_protocol_environment_alpha__Environment.Micheline.Prim 0
                  Tezos_raw_protocol_alpha.Michelson_v1_primitives.D_Pair
                  (cons
                    (Tezos_protocol_environment_alpha__Environment.Micheline.Bytes
                      0
                      (Data_encoding.Binary.to_bytes_exn
                        Signature.Public_key_hash.encoding manager_pkh))
                    (cons storage_expr [])) [] in
              ((op_atat Script_repr.lazy_expr (strip_locations migrated_code)),
                (op_atat Script_repr.lazy_expr
                  (strip_locations migrated_storage)))
            | _ => (script_code, script_storage)
            end
          | _ => (script_code, script_storage)
          end)).

Definition has_default_entrypoint
  (expr : Tezos_raw_protocol_alpha.Script_repr.lazy_expr) : bool :=
  match Script_repr.force_decode expr with
  | Tezos_protocol_environment_alpha__Environment.Pervasives.Error _ => false
  | Tezos_protocol_environment_alpha__Environment.Pervasives.Ok (expr, _) =>
    match root expr with
    | Tezos_protocol_environment_alpha__Environment.Micheline.Seq _ toplevel =>
      match
        find_toplevel
          Tezos_raw_protocol_alpha.Michelson_v1_primitives.K_parameter toplevel
        with
      |
        Some
          (Tezos_protocol_environment_alpha__Environment.Micheline.Prim _
            Tezos_raw_protocol_alpha.Michelson_v1_primitives.K_parameter
            (cons _ []) (cons "%default" % string [])) => false
      |
        Some
          (Tezos_protocol_environment_alpha__Environment.Micheline.Prim _
            Tezos_raw_protocol_alpha.Michelson_v1_primitives.K_parameter
            (cons parameter_expr []) _) =>
        let fix has_default {A : Set}
          (function_parameter :
          Tezos_protocol_environment_alpha__Environment.Micheline.node A
            Tezos_raw_protocol_alpha.Michelson_v1_primitives.prim) : bool :=
          match function_parameter with
          |
            Tezos_protocol_environment_alpha__Environment.Micheline.Prim _
              Tezos_raw_protocol_alpha.Michelson_v1_primitives.T_or
              (cons l (cons r [])) annots =>
            op_pipepipe
              (List.__exists (String.equal "%default" % string) annots)
              (op_pipepipe (has_default l) (has_default r))
          |
            Tezos_protocol_environment_alpha__Environment.Micheline.Prim _ _ _
              annots => List.__exists (String.equal "%default" % string) annots
          | _ => false
          end in
        has_default parameter_expr
      | Some _ | None => false
      end
    | _ => false
    end
  end.

Definition add_root_entrypoint
  (script_code : Tezos_raw_protocol_alpha.Script_repr.lazy_expr)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Script_repr.lazy_expr) :=
  op_gtgtpipequestion (Lwt.__return (Script_repr.force_decode script_code))
    (fun function_parameter =>
      let '(script_code_expr, _gas_cost) := function_parameter in
      match root script_code_expr with
      | Tezos_protocol_environment_alpha__Environment.Micheline.Seq _ toplevel
        =>
        let migrated_code :=
          Tezos_protocol_environment_alpha__Environment.Micheline.Seq 0
            (List.map
              (fun function_parameter =>
                match function_parameter with
                |
                  Tezos_protocol_environment_alpha__Environment.Micheline.Prim _
                    Tezos_raw_protocol_alpha.Michelson_v1_primitives.K_parameter
                    (cons parameter_expr []) _ =>
                  Tezos_protocol_environment_alpha__Environment.Micheline.Prim 0
                    Tezos_raw_protocol_alpha.Michelson_v1_primitives.K_parameter
                    (cons parameter_expr []) (cons "%root" % string [])
                |
                  Tezos_protocol_environment_alpha__Environment.Micheline.Prim _
                    Tezos_raw_protocol_alpha.Michelson_v1_primitives.K_code
                    exprs annots =>
                  let fix rewrite_self
                    (function_parameter :
                    Tezos_protocol_environment_alpha__Environment.Micheline.node
                      Z Tezos_raw_protocol_alpha.Michelson_v1_primitives.prim)
                    : Tezos_protocol_environment_alpha__Environment.Micheline.node
                      Z Tezos_raw_protocol_alpha.Michelson_v1_primitives.prim :=
                    match function_parameter with
                    |
                      (Tezos_protocol_environment_alpha__Environment.Micheline.Int
                        _ _ |
                        Tezos_protocol_environment_alpha__Environment.Micheline.String
                          _ _ |
                        Tezos_protocol_environment_alpha__Environment.Micheline.Bytes
                          _ _ |
                        Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                          _
                          Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_CREATE_CONTRACT
                          _ _) as leaf => leaf
                    |
                      Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                        _
                        Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_SELF
                        [] annots =>
                      Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                        0
                        Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_SELF
                        [] (cons "%root" % string annots)
                    |
                      Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                        _ name args annots =>
                      Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                        0 name (List.map rewrite_self args) annots
                    |
                      Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                        _ args =>
                      Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                        0 (List.map rewrite_self args)
                    end in
                  Tezos_protocol_environment_alpha__Environment.Micheline.Prim 0
                    Tezos_raw_protocol_alpha.Michelson_v1_primitives.K_code
                    (List.map rewrite_self exprs) annots
                | other => other
                end) toplevel) in
        op_atat Script_repr.lazy_expr (strip_locations migrated_code)
      | _ => script_code
      end).

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(* Copyright (c) 2019 Nomadic Labs <contact@nomadic-labs.com>                *)
(* Copyright (c) 2019 Cryptium Labs <contact@cryptium-labs.com>              *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

(** This code mimics the now defunct scriptless KT1s.

    The manager contract is from:
    https://gitlab.com/nomadic-labs/mi-cho-coq/blob/7b42f2e970e1541af54f8a9b6820b4f18e847575/src/contracts/manager.tz
    The formal proof is at:
    https://gitlab.com/nomadic-labs/mi-cho-coq/blob/a7603e12021166e15890f6d504feebec2f945502/src/contracts_coq/manager.v *)
val manager_script_code : Script_repr.lazy_expr

(** This code mimics the now defunct "spendable" flags of KT1s by
    adding a [do] entrypoint, preserving the original script's at
    'default' entrypoint.

    The pseudo-code for the applied transformations is from:
    https://gitlab.com/nomadic-labs/mi-cho-coq/blob/7b42f2e970e1541af54f8a9b6820b4f18e847575/src/contracts/transform/add_do.tz *)
val add_do :
  manager_pkh:Signature.Public_key_hash.t ->
  script_code:Script_repr.lazy_expr ->
  script_storage:Script_repr.lazy_expr ->
  (Script_repr.lazy_expr * Script_repr.lazy_expr) tzresult Lwt.t

(** This code mimics the now defunct "spendable" flags of KT1s by
    adding a [do] entrypoint, preserving the original script's at
    'default' entrypoint.

    The pseudo-code for the applied transformations is from:
    https://gitlab.com/nomadic-labs/mi-cho-coq/blob/7b42f2e970e1541af54f8a9b6820b4f18e847575/src/contracts/transform/add_set_delegate.tz *)
val add_set_delegate :
  manager_pkh:Signature.Public_key_hash.t ->
  script_code:Script_repr.lazy_expr ->
  script_storage:Script_repr.lazy_expr ->
  (Script_repr.lazy_expr * Script_repr.lazy_expr) tzresult Lwt.t

(** Checks if a contract was declaring a default entrypoint somewhere
   else than at the root, in which case its type changes when
   entrypoints are activated. *)
val has_default_entrypoint : Script_repr.lazy_expr -> bool

(** Adds a [%root] annotation on the toplevel parameter construct. *)
val add_root_entrypoint :
  script_code:Script_repr.lazy_expr -> Script_repr.lazy_expr tzresult Lwt.t

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Parameter manager_script_code : Tezos_raw_protocol_alpha.Script_repr.lazy_expr.

Parameter add_do :
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Tezos_raw_protocol_alpha.Script_repr.lazy_expr ->
  Tezos_raw_protocol_alpha.Script_repr.lazy_expr ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Script_repr.lazy_expr *
        Tezos_raw_protocol_alpha.Script_repr.lazy_expr)).

Parameter add_set_delegate :
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Tezos_raw_protocol_alpha.Script_repr.lazy_expr ->
  Tezos_raw_protocol_alpha.Script_repr.lazy_expr ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Script_repr.lazy_expr *
        Tezos_raw_protocol_alpha.Script_repr.lazy_expr)).

Parameter has_default_entrypoint :
  Tezos_raw_protocol_alpha.Script_repr.lazy_expr -> bool.

Parameter add_root_entrypoint :
  Tezos_raw_protocol_alpha.Script_repr.lazy_expr ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Script_repr.lazy_expr).

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

type t = {
  level : Raw_level_repr.t;
  level_position : int32;
  cycle : Cycle_repr.t;
  cycle_position : int32;
  voting_period : Voting_period_repr.t;
  voting_period_position : int32;
  expected_commitment : bool;
}

include Compare.Make (struct
  type nonrec t = t

  let compare {level = l1} {level = l2} = Raw_level_repr.compare l1 l2
end)

type level = t

let pp ppf {level} = Raw_level_repr.pp ppf level

let pp_full ppf l =
  Format.fprintf
    ppf
    "%a.%ld (cycle %a.%ld) (vote %a.%ld)"
    Raw_level_repr.pp
    l.level
    l.level_position
    Cycle_repr.pp
    l.cycle
    l.cycle_position
    Voting_period_repr.pp
    l.voting_period
    l.voting_period_position

let encoding =
  let open Data_encoding in
  conv
    (fun { level;
           level_position;
           cycle;
           cycle_position;
           voting_period;
           voting_period_position;
           expected_commitment } ->
      ( level,
        level_position,
        cycle,
        cycle_position,
        voting_period,
        voting_period_position,
        expected_commitment ))
    (fun ( level,
           level_position,
           cycle,
           cycle_position,
           voting_period,
           voting_period_position,
           expected_commitment ) ->
      {
        level;
        level_position;
        cycle;
        cycle_position;
        voting_period;
        voting_period_position;
        expected_commitment;
      })
    (obj7
       (req
          "level"
          ~description:
            "The level of the block relative to genesis. This is also the \
             Shell's notion of level"
          Raw_level_repr.encoding)
       (req
          "level_position"
          ~description:
            "The level of the block relative to the block that starts \
             protocol alpha. This is specific to the protocol alpha. Other \
             protocols might or might not include a similar notion."
          int32)
       (req
          "cycle"
          ~description:
            "The current cycle's number. Note that cycles are a \
             protocol-specific notion. As a result, the cycle number starts \
             at 0 with the first block of protocol alpha."
          Cycle_repr.encoding)
       (req
          "cycle_position"
          ~description:
            "The current level of the block relative to the first block of \
             the current cycle."
          int32)
       (req
          "voting_period"
          ~description:
            "The current voting period's index. Note that cycles are a \
             protocol-specific notion. As a result, the voting period index \
             starts at 0 with the first block of protocol alpha."
          Voting_period_repr.encoding)
       (req
          "voting_period_position"
          ~description:
            "The current level of the block relative to the first block of \
             the current voting period."
          int32)
       (req
          "expected_commitment"
          ~description:
            "Tells wether the baker of this block has to commit a seed nonce \
             hash."
          bool))

let root first_level =
  {
    level = first_level;
    level_position = 0l;
    cycle = Cycle_repr.root;
    cycle_position = 0l;
    voting_period = Voting_period_repr.root;
    voting_period_position = 0l;
    expected_commitment = false;
  }

let from_raw ~first_level ~blocks_per_cycle ~blocks_per_voting_period
    ~blocks_per_commitment level =
  let raw_level = Raw_level_repr.to_int32 level in
  let first_level = Raw_level_repr.to_int32 first_level in
  let level_position =
    Compare.Int32.max 0l (Int32.sub raw_level first_level)
  in
  let cycle =
    Cycle_repr.of_int32_exn (Int32.div level_position blocks_per_cycle)
  in
  let cycle_position = Int32.rem level_position blocks_per_cycle in
  let voting_period =
    Voting_period_repr.of_int32_exn
      (Int32.div level_position blocks_per_voting_period)
  in
  let voting_period_position =
    Int32.rem level_position blocks_per_voting_period
  in
  let expected_commitment =
    Compare.Int32.(
      Int32.rem cycle_position blocks_per_commitment
      = Int32.pred blocks_per_commitment)
  in
  {
    level;
    level_position;
    cycle;
    cycle_position;
    voting_period;
    voting_period_position;
    expected_commitment;
  }

let diff {level = l1; _} {level = l2; _} =
  Int32.sub (Raw_level_repr.to_int32 l1) (Raw_level_repr.to_int32 l2)

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Module t.
  Record record := {
    level : Tezos_raw_protocol_alpha.Raw_level_repr.t;
    level_position : int32;
    cycle : Tezos_raw_protocol_alpha.Cycle_repr.t;
    cycle_position : int32;
    voting_period : Tezos_raw_protocol_alpha.Voting_period_repr.t;
    voting_period_position : int32;
    expected_commitment : bool }.
End t.
Definition t := t.record.

(* ❌ Cannot include this kind of module expression *)
include

Definition level := t.

Definition pp
  (ppf : Tezos_protocol_environment_alpha__Environment.Format.formatter)
  (function_parameter : t) : unit :=
  let '{| t.level := level |} := function_parameter in
  Raw_level_repr.pp ppf level.

Definition pp_full
  (ppf : Tezos_protocol_environment_alpha__Environment.Format.formatter) (l : t)
  : unit :=
  Format.fprintf ppf
    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Char_literal
          "." % char
          (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int32
            Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int_d
            Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
            Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_precision
            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
              " (cycle " % string
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Char_literal
                  "." % char
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int32
                    Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int_d
                    Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
                    Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_precision
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                      ") (vote " % string
                      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Char_literal
                          "." % char
                          (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int32
                            Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int_d
                            Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
                            Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_precision
                            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Char_literal
                              ")" % char
                              Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format))))))))))))
      "%a.%ld (cycle %a.%ld) (vote %a.%ld)" % string) Raw_level_repr.pp
    (t.level l) (t.level_position l) Cycle_repr.pp (t.cycle l)
    (t.cycle_position l) Voting_period_repr.pp (t.voting_period l)
    (t.voting_period_position l).

Definition encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding t :=
  conv
    (fun function_parameter =>
      let '{|
        t.level := level;
          t.level_position := level_position;
          t.cycle := cycle;
          t.cycle_position := cycle_position;
          t.voting_period := voting_period;
          t.voting_period_position := voting_period_position;
          t.expected_commitment := expected_commitment
          |} := function_parameter in
      (level, level_position, cycle, cycle_position, voting_period,
        voting_period_position, expected_commitment))
    (fun function_parameter =>
      let
        '(level, level_position, cycle, cycle_position, voting_period,
          voting_period_position, expected_commitment) := function_parameter in
      {| t.level := level; t.level_position := level_position; t.cycle := cycle;
        t.cycle_position := cycle_position; t.voting_period := voting_period;
        t.voting_period_position := voting_period_position;
        t.expected_commitment := expected_commitment |}) None
    (obj7
      (req None
        (Some
          "The level of the block relative to genesis. This is also the Shell's notion of level"
            % string) "level" % string Raw_level_repr.encoding)
      (req None
        (Some
          "The level of the block relative to the block that starts protocol alpha. This is specific to the protocol alpha. Other protocols might or might not include a similar notion."
            % string) "level_position" % string __int32_value)
      (req None
        (Some
          "The current cycle's number. Note that cycles are a protocol-specific notion. As a result, the cycle number starts at 0 with the first block of protocol alpha."
            % string) "cycle" % string Cycle_repr.encoding)
      (req None
        (Some
          "The current level of the block relative to the first block of the current cycle."
            % string) "cycle_position" % string __int32_value)
      (req None
        (Some
          "The current voting period's index. Note that cycles are a protocol-specific notion. As a result, the voting period index starts at 0 with the first block of protocol alpha."
            % string) "voting_period" % string Voting_period_repr.encoding)
      (req None
        (Some
          "The current level of the block relative to the first block of the current voting period."
            % string) "voting_period_position" % string __int32_value)
      (req None
        (Some
          "Tells wether the baker of this block has to commit a seed nonce hash."
            % string) "expected_commitment" % string __bool_value)).

Definition root (first_level : Tezos_raw_protocol_alpha.Raw_level_repr.t) : t :=
  {| t.level := first_level;
    t.level_position :=
      (* ❌ Constant of type int32 is converted to int *)
      0; t.cycle := Cycle_repr.root;
    t.cycle_position :=
      (* ❌ Constant of type int32 is converted to int *)
      0; t.voting_period := Voting_period_repr.root;
    t.voting_period_position :=
      (* ❌ Constant of type int32 is converted to int *)
      0; t.expected_commitment := false |}.

Definition from_raw
  (first_level : Tezos_raw_protocol_alpha.Raw_level_repr.raw_level)
  (blocks_per_cycle : int32) (blocks_per_voting_period : int32)
  (blocks_per_commitment : int32)
  (level : Tezos_raw_protocol_alpha.Raw_level_repr.raw_level) : t :=
  let raw_level := Raw_level_repr.to_int32 level in
  let first_level := Raw_level_repr.to_int32 first_level in
  let level_position :=
    Compare.Int32.max
      (* ❌ Constant of type int32 is converted to int *)
      0 (Int32.sub raw_level first_level) in
  let cycle :=
    Cycle_repr.of_int32_exn (Int32.div level_position blocks_per_cycle) in
  let cycle_position := Int32.rem level_position blocks_per_cycle in
  let voting_period :=
    Voting_period_repr.of_int32_exn
      (Int32.div level_position blocks_per_voting_period) in
  let voting_period_position :=
    Int32.rem level_position blocks_per_voting_period in
  let expected_commitment :=
    op_eq (Int32.rem cycle_position blocks_per_commitment)
      (Int32.pred blocks_per_commitment) in
  {| t.level := level; t.level_position := level_position; t.cycle := cycle;
    t.cycle_position := cycle_position; t.voting_period := voting_period;
    t.voting_period_position := voting_period_position;
    t.expected_commitment := expected_commitment |}.

Definition diff (function_parameter : t) : t -> int32 :=
  let '{| t.level := l1 |} := function_parameter in
  fun function_parameter =>
    let '{| t.level := l2 |} := function_parameter in
    Int32.sub (Raw_level_repr.to_int32 l1) (Raw_level_repr.to_int32 l2).

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

type t = private {
  level : Raw_level_repr.t;
      (** The level of the block relative to genesis. This
                              is also the Shell's notion of level. *)
  level_position : int32;
      (** The level of the block relative to the block that
                            starts protocol alpha. This is specific to the
                            protocol alpha. Other protocols might or might not
                            include a similar notion. *)
  cycle : Cycle_repr.t;
      (** The current cycle's number. Note that cycles are a
                          protocol-specific notion. As a result, the cycle
                          number starts at 0 with the first block of protocol
                          alpha. *)
  cycle_position : int32;
      (** The current level of the block relative to the first
                            block of the current cycle. *)
  voting_period : Voting_period_repr.t;
  voting_period_position : int32;
  expected_commitment : bool;
}

(* Note that, the type `t` above must respect some invariants (hence the
   `private` annotation). Notably:

   level_position = cycle * blocks_per_cycle + cycle_position
*)

type level = t

include Compare.S with type t := level

val encoding : level Data_encoding.t

val pp : Format.formatter -> level -> unit

val pp_full : Format.formatter -> level -> unit

val root : Raw_level_repr.t -> level

val from_raw :
  first_level:Raw_level_repr.t ->
  blocks_per_cycle:int32 ->
  blocks_per_voting_period:int32 ->
  blocks_per_commitment:int32 ->
  Raw_level_repr.t ->
  level

val diff : level -> level -> int32

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Module t.
  Record record := {
    level : Tezos_raw_protocol_alpha.Raw_level_repr.t;
    level_position : int32;
    cycle : Tezos_raw_protocol_alpha.Cycle_repr.t;
    cycle_position : int32;
    voting_period : Tezos_raw_protocol_alpha.Voting_period_repr.t;
    voting_period_position : int32;
    expected_commitment : bool }.
End t.
Definition t := t.record.

Definition level := t.

Parameter op_eq : level -> level -> bool.

Parameter op_ltgt : level -> level -> bool.

Parameter op_lt : level -> level -> bool.

Parameter op_lteq : level -> level -> bool.

Parameter op_gteq : level -> level -> bool.

Parameter op_gt : level -> level -> bool.

Parameter compare : level -> level -> Z.

Parameter equal : level -> level -> bool.

Parameter max : level -> level -> level.

Parameter min : level -> level -> level.

Parameter encoding :
  Tezos_protocol_environment_alpha__Environment.Data_encoding.t level.

Parameter pp :
  Tezos_protocol_environment_alpha__Environment.Format.formatter -> level ->
  unit.

Parameter pp_full :
  Tezos_protocol_environment_alpha__Environment.Format.formatter -> level ->
  unit.

Parameter root : Tezos_raw_protocol_alpha.Raw_level_repr.t -> level.

Parameter from_raw :
  Tezos_raw_protocol_alpha.Raw_level_repr.t -> int32 -> int32 -> int32 ->
  Tezos_raw_protocol_alpha.Raw_level_repr.t -> level.

Parameter diff : level -> level -> int32.

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Level_repr

let from_raw c ?offset l =
  let l =
    match offset with
    | None ->
        l
    | Some o ->
        Raw_level_repr.(of_int32_exn (Int32.add (to_int32 l) o))
  in
  let constants = Raw_context.constants c in
  let first_level = Raw_context.first_level c in
  Level_repr.from_raw
    ~first_level
    ~blocks_per_cycle:constants.Constants_repr.blocks_per_cycle
    ~blocks_per_voting_period:constants.Constants_repr.blocks_per_voting_period
    ~blocks_per_commitment:constants.Constants_repr.blocks_per_commitment
    l

let root c = Level_repr.root (Raw_context.first_level c)

let succ c l = from_raw c (Raw_level_repr.succ l.level)

let pred c l =
  match Raw_level_repr.pred l.Level_repr.level with
  | None ->
      None
  | Some l ->
      Some (from_raw c l)

let current ctxt = Raw_context.current_level ctxt

let previous ctxt =
  let l = current ctxt in
  match pred ctxt l with
  | None ->
      assert false (* We never validate the Genesis... *)
  | Some p ->
      p

let first_level_in_cycle ctxt c =
  let constants = Raw_context.constants ctxt in
  let first_level = Raw_context.first_level ctxt in
  from_raw
    ctxt
    (Raw_level_repr.of_int32_exn
       (Int32.add
          (Raw_level_repr.to_int32 first_level)
          (Int32.mul
             constants.Constants_repr.blocks_per_cycle
             (Cycle_repr.to_int32 c))))

let last_level_in_cycle ctxt c =
  match pred ctxt (first_level_in_cycle ctxt (Cycle_repr.succ c)) with
  | None ->
      assert false
  | Some x ->
      x

let levels_in_cycle ctxt cycle =
  let first = first_level_in_cycle ctxt cycle in
  let rec loop n acc =
    if Cycle_repr.(n.cycle = first.cycle) then loop (succ ctxt n) (n :: acc)
    else acc
  in
  loop first []

let levels_in_current_cycle ctxt ?(offset = 0l) () =
  let current_cycle = Cycle_repr.to_int32 (current ctxt).cycle in
  let cycle = Int32.add current_cycle offset in
  if Compare.Int32.(cycle < 0l) then []
  else
    let cycle = Cycle_repr.of_int32_exn cycle in
    levels_in_cycle ctxt cycle

let levels_with_commitments_in_cycle ctxt c =
  let first = first_level_in_cycle ctxt c in
  let rec loop n acc =
    if Cycle_repr.(n.cycle = first.cycle) then
      if n.expected_commitment then loop (succ ctxt n) (n :: acc)
      else loop (succ ctxt n) acc
    else acc
  in
  loop first []

let last_allowed_fork_level c =
  let level = Raw_context.current_level c in
  let preserved_cycles = Constants_storage.preserved_cycles c in
  match Cycle_repr.sub level.cycle preserved_cycles with
  | None ->
      Raw_level_repr.root
  | Some cycle ->
      (first_level_in_cycle c cycle).level

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Import Level_repr.

Definition from_raw
  (c : Tezos_raw_protocol_alpha.Raw_context.context) (offset : option int32)
  (l : Tezos_raw_protocol_alpha.Raw_level_repr.raw_level)
  : Tezos_raw_protocol_alpha.Level_repr.level :=
  let l :=
    match offset with
    | None => l
    | Some o => of_int32_exn (Int32.add (to_int32 l) o)
    end in
  let constants := Raw_context.constants c in
  let first_level := Raw_context.first_level c in
  Level_repr.from_raw first_level
    (Tezos_raw_protocol_alpha.Constants_repr.parametric.blocks_per_cycle
      constants)
    (Tezos_raw_protocol_alpha.Constants_repr.parametric.blocks_per_voting_period
      constants)
    (Tezos_raw_protocol_alpha.Constants_repr.parametric.blocks_per_commitment
      constants) l.

Definition root (c : Tezos_raw_protocol_alpha.Raw_context.context)
  : Tezos_raw_protocol_alpha.Level_repr.level :=
  Level_repr.root (Raw_context.first_level c).

Definition succ
  (c : Tezos_raw_protocol_alpha.Raw_context.context)
  (l : Tezos_raw_protocol_alpha.Level_repr.t)
  : Tezos_raw_protocol_alpha.Level_repr.level :=
  from_raw c None
    (Raw_level_repr.succ (Tezos_raw_protocol_alpha.Level_repr.t.level l)).

Definition pred
  (c : Tezos_raw_protocol_alpha.Raw_context.context)
  (l : Tezos_raw_protocol_alpha.Level_repr.t)
  : option Tezos_raw_protocol_alpha.Level_repr.level :=
  match Raw_level_repr.pred (Tezos_raw_protocol_alpha.Level_repr.t.level l) with
  | None => None
  | Some l => Some (from_raw c None l)
  end.

Definition current (ctxt : Tezos_raw_protocol_alpha.Raw_context.context)
  : Tezos_raw_protocol_alpha.Level_repr.t := Raw_context.current_level ctxt.

Definition previous (ctxt : Tezos_raw_protocol_alpha.Raw_context.context)
  : Tezos_raw_protocol_alpha.Level_repr.level :=
  let l := current ctxt in
  match pred ctxt l with
  | None =>
    (* ❌ Assert instruction is not handled. *)
    assert false
  | Some p => p
  end.

Definition first_level_in_cycle
  (ctxt : Tezos_raw_protocol_alpha.Raw_context.context)
  (c : Tezos_raw_protocol_alpha.Cycle_repr.cycle)
  : Tezos_raw_protocol_alpha.Level_repr.level :=
  let constants := Raw_context.constants ctxt in
  let first_level := Raw_context.first_level ctxt in
  from_raw ctxt None
    (Raw_level_repr.of_int32_exn
      (Int32.add (Raw_level_repr.to_int32 first_level)
        (Int32.mul
          (Tezos_raw_protocol_alpha.Constants_repr.parametric.blocks_per_cycle
            constants) (Cycle_repr.to_int32 c)))).

Definition last_level_in_cycle
  (ctxt : Tezos_raw_protocol_alpha.Raw_context.context)
  (c : Tezos_raw_protocol_alpha.Cycle_repr.cycle)
  : Tezos_raw_protocol_alpha.Level_repr.level :=
  match pred ctxt (first_level_in_cycle ctxt (Cycle_repr.succ c)) with
  | None =>
    (* ❌ Assert instruction is not handled. *)
    assert false
  | Some x => x
  end.

Definition levels_in_cycle
  (ctxt : Tezos_raw_protocol_alpha.Raw_context.context)
  (cycle : Tezos_raw_protocol_alpha.Cycle_repr.cycle)
  : list Tezos_raw_protocol_alpha.Level_repr.t :=
  let first := first_level_in_cycle ctxt cycle in
  let fix loop
    (n : Tezos_raw_protocol_alpha.Level_repr.t) (acc :
    list Tezos_raw_protocol_alpha.Level_repr.t)
    : list Tezos_raw_protocol_alpha.Level_repr.t :=
    if
      op_eq (Tezos_raw_protocol_alpha.Level_repr.t.cycle n)
        (Tezos_raw_protocol_alpha.Level_repr.t.cycle first) then
      loop (succ ctxt n) (cons n acc)
    else
      acc in
  loop first [].

Definition levels_in_current_cycle
  (ctxt : Tezos_raw_protocol_alpha.Raw_context.context)
  (op_staroptstar : option int32)
  : unit -> list Tezos_raw_protocol_alpha.Level_repr.t :=
  let offset :=
    match op_staroptstar with
    | Some op_starsthstar => op_starsthstar
    | None =>
      (* ❌ Constant of type int32 is converted to int *)
      0
    end in
  fun function_parameter =>
    let 'tt := function_parameter in
    let current_cycle :=
      Cycle_repr.to_int32
        (Tezos_raw_protocol_alpha.Level_repr.t.cycle (current ctxt)) in
    let cycle := Int32.add current_cycle offset in
    if
      op_lt cycle
        (* ❌ Constant of type int32 is converted to int *)
        0 then
      []
    else
      let cycle := Cycle_repr.of_int32_exn cycle in
      levels_in_cycle ctxt cycle.

Definition levels_with_commitments_in_cycle
  (ctxt : Tezos_raw_protocol_alpha.Raw_context.context)
  (c : Tezos_raw_protocol_alpha.Cycle_repr.cycle)
  : list Tezos_raw_protocol_alpha.Level_repr.t :=
  let first := first_level_in_cycle ctxt c in
  let fix loop
    (n : Tezos_raw_protocol_alpha.Level_repr.t) (acc :
    list Tezos_raw_protocol_alpha.Level_repr.t)
    : list Tezos_raw_protocol_alpha.Level_repr.t :=
    if
      op_eq (Tezos_raw_protocol_alpha.Level_repr.t.cycle n)
        (Tezos_raw_protocol_alpha.Level_repr.t.cycle first) then
      if Tezos_raw_protocol_alpha.Level_repr.t.expected_commitment n then
        loop (succ ctxt n) (cons n acc)
      else
        loop (succ ctxt n) acc
    else
      acc in
  loop first [].

Definition last_allowed_fork_level
  (c : Tezos_raw_protocol_alpha.Raw_context.context)
  : Tezos_raw_protocol_alpha.Raw_level_repr.raw_level :=
  let level := Raw_context.current_level c in
  let preserved_cycles := Constants_storage.preserved_cycles c in
  match
    Cycle_repr.sub (Tezos_raw_protocol_alpha.Level_repr.t.cycle level)
      preserved_cycles with
  | None => Raw_level_repr.root
  | Some cycle =>
    Tezos_raw_protocol_alpha.Level_repr.t.level (first_level_in_cycle c cycle)
  end.

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

val current : Raw_context.t -> Level_repr.t

val previous : Raw_context.t -> Level_repr.t

val root : Raw_context.t -> Level_repr.t

val from_raw :
  Raw_context.t -> ?offset:int32 -> Raw_level_repr.t -> Level_repr.t

val pred : Raw_context.t -> Level_repr.t -> Level_repr.t option

val succ : Raw_context.t -> Level_repr.t -> Level_repr.t

val first_level_in_cycle : Raw_context.t -> Cycle_repr.t -> Level_repr.t

val last_level_in_cycle : Raw_context.t -> Cycle_repr.t -> Level_repr.t

val levels_in_cycle : Raw_context.t -> Cycle_repr.t -> Level_repr.t list

val levels_in_current_cycle :
  Raw_context.t -> ?offset:int32 -> unit -> Level_repr.t list

val levels_with_commitments_in_cycle :
  Raw_context.t -> Cycle_repr.t -> Level_repr.t list

val last_allowed_fork_level : Raw_context.t -> Raw_level_repr.t

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Parameter current :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Level_repr.t.

Parameter previous :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Level_repr.t.

Parameter root :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Level_repr.t.

Parameter from_raw :
  Tezos_raw_protocol_alpha.Raw_context.t -> option int32 ->
  Tezos_raw_protocol_alpha.Raw_level_repr.t ->
  Tezos_raw_protocol_alpha.Level_repr.t.

Parameter pred :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Level_repr.t ->
  option Tezos_raw_protocol_alpha.Level_repr.t.

Parameter succ :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Level_repr.t -> Tezos_raw_protocol_alpha.Level_repr.t.

Parameter first_level_in_cycle :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Cycle_repr.t -> Tezos_raw_protocol_alpha.Level_repr.t.

Parameter last_level_in_cycle :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Cycle_repr.t -> Tezos_raw_protocol_alpha.Level_repr.t.

Parameter levels_in_cycle :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Cycle_repr.t ->
  list Tezos_raw_protocol_alpha.Level_repr.t.

Parameter levels_in_current_cycle :
  Tezos_raw_protocol_alpha.Raw_context.t -> option int32 -> unit ->
  list Tezos_raw_protocol_alpha.Level_repr.t.

Parameter levels_with_commitments_in_cycle :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Cycle_repr.t ->
  list Tezos_raw_protocol_alpha.Level_repr.t.

Parameter last_allowed_fork_level :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Raw_level_repr.t.

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

(* Tezos Protocol Implementation - Protocol Signature Instance *)

type block_header_data = Alpha_context.Block_header.protocol_data

type block_header = Alpha_context.Block_header.t = {
  shell : Block_header.shell_header;
  protocol_data : block_header_data;
}

let block_header_data_encoding =
  Alpha_context.Block_header.protocol_data_encoding

type block_header_metadata = Apply_results.block_metadata

let block_header_metadata_encoding = Apply_results.block_metadata_encoding

type operation_data = Alpha_context.packed_protocol_data =
  | Operation_data :
      'kind Alpha_context.Operation.protocol_data
      -> operation_data

let operation_data_encoding = Alpha_context.Operation.protocol_data_encoding

type operation_receipt = Apply_results.packed_operation_metadata =
  | Operation_metadata :
      'kind Apply_results.operation_metadata
      -> operation_receipt
  | No_operation_metadata : operation_receipt

let operation_receipt_encoding = Apply_results.operation_metadata_encoding

let operation_data_and_receipt_encoding =
  Apply_results.operation_data_and_metadata_encoding

type operation = Alpha_context.packed_operation = {
  shell : Operation.shell_header;
  protocol_data : operation_data;
}

let acceptable_passes = Alpha_context.Operation.acceptable_passes

let max_block_length = Alpha_context.Block_header.max_header_length

let max_operation_data_length =
  Alpha_context.Constants.max_operation_data_length

let validation_passes =
  let max_anonymous_operations =
    Alpha_context.Constants.max_revelations_per_block
    + (* allow 100 wallet activations or denunciations per block *) 100
  in
  Updater.
    [ {max_size = 32 * 1024; max_op = Some 32};
      (* 32 endorsements *)
      {max_size = 32 * 1024; max_op = None};
      (* 32k of voting operations *)
      {
        max_size = max_anonymous_operations * 1024;
        max_op = Some max_anonymous_operations;
      };
      {max_size = 512 * 1024; max_op = None} ]

(* 512kB *)

let rpc_services =
  Alpha_services.register () ;
  Services_registration.get_rpc_services ()

type validation_mode =
  | Application of {
      block_header : Alpha_context.Block_header.t;
      baker : Alpha_context.public_key_hash;
      block_delay : Alpha_context.Period.t;
    }
  | Partial_application of {
      block_header : Alpha_context.Block_header.t;
      baker : Alpha_context.public_key_hash;
      block_delay : Alpha_context.Period.t;
    }
  | Partial_construction of {predecessor : Block_hash.t}
  | Full_construction of {
      predecessor : Block_hash.t;
      protocol_data : Alpha_context.Block_header.contents;
      baker : Alpha_context.public_key_hash;
      block_delay : Alpha_context.Period.t;
    }

type validation_state = {
  mode : validation_mode;
  chain_id : Chain_id.t;
  ctxt : Alpha_context.t;
  op_count : int;
}

let current_context {ctxt; _} = return (Alpha_context.finalize ctxt).context

let begin_partial_application ~chain_id ~ancestor_context:ctxt
    ~predecessor_timestamp ~predecessor_fitness
    (block_header : Alpha_context.Block_header.t) =
  let level = block_header.shell.level in
  let fitness = predecessor_fitness in
  let timestamp = block_header.shell.timestamp in
  Alpha_context.prepare ~level ~predecessor_timestamp ~timestamp ~fitness ctxt
  >>=? fun ctxt ->
  Apply.begin_application ctxt chain_id block_header predecessor_timestamp
  >>=? fun (ctxt, baker, block_delay) ->
  let mode =
    Partial_application
      {block_header; baker = Signature.Public_key.hash baker; block_delay}
  in
  return {mode; chain_id; ctxt; op_count = 0}

let begin_application ~chain_id ~predecessor_context:ctxt
    ~predecessor_timestamp ~predecessor_fitness
    (block_header : Alpha_context.Block_header.t) =
  let level = block_header.shell.level in
  let fitness = predecessor_fitness in
  let timestamp = block_header.shell.timestamp in
  Alpha_context.prepare ~level ~predecessor_timestamp ~timestamp ~fitness ctxt
  >>=? fun ctxt ->
  Apply.begin_application ctxt chain_id block_header predecessor_timestamp
  >>=? fun (ctxt, baker, block_delay) ->
  let mode =
    Application
      {block_header; baker = Signature.Public_key.hash baker; block_delay}
  in
  return {mode; chain_id; ctxt; op_count = 0}

let begin_construction ~chain_id ~predecessor_context:ctxt
    ~predecessor_timestamp ~predecessor_level:pred_level
    ~predecessor_fitness:pred_fitness ~predecessor ~timestamp
    ?(protocol_data : block_header_data option) () =
  let level = Int32.succ pred_level in
  let fitness = pred_fitness in
  Alpha_context.prepare ~level ~predecessor_timestamp ~timestamp ~fitness ctxt
  >>=? fun ctxt ->
  ( match protocol_data with
  | None ->
      Apply.begin_partial_construction ctxt
      >>=? fun ctxt ->
      let mode = Partial_construction {predecessor} in
      return (mode, ctxt)
  | Some proto_header ->
      Apply.begin_full_construction
        ctxt
        predecessor_timestamp
        proto_header.contents
      >>=? fun (ctxt, protocol_data, baker, block_delay) ->
      let mode =
        let baker = Signature.Public_key.hash baker in
        Full_construction {predecessor; baker; protocol_data; block_delay}
      in
      return (mode, ctxt) )
  >>=? fun (mode, ctxt) -> return {mode; chain_id; ctxt; op_count = 0}

let apply_operation ({mode; chain_id; ctxt; op_count; _} as data)
    (operation : Alpha_context.packed_operation) =
  match mode with
  | Partial_application _
    when not
           (List.exists
              (Compare.Int.equal 0)
              (Alpha_context.Operation.acceptable_passes operation)) ->
      (* Multipass validation only considers operations in pass 0. *)
      let op_count = op_count + 1 in
      return ({data with ctxt; op_count}, No_operation_metadata)
  | _ ->
      let {shell; protocol_data = Operation_data protocol_data} = operation in
      let operation : _ Alpha_context.operation = {shell; protocol_data} in
      let (predecessor, baker) =
        match mode with
        | Partial_application
            {block_header = {shell = {predecessor; _}; _}; baker}
        | Application {block_header = {shell = {predecessor; _}; _}; baker}
        | Full_construction {predecessor; baker; _} ->
            (predecessor, baker)
        | Partial_construction {predecessor} ->
            (predecessor, Signature.Public_key_hash.zero)
      in
      Apply.apply_operation
        ctxt
        chain_id
        Optimized
        predecessor
        baker
        (Alpha_context.Operation.hash operation)
        operation
      >>=? fun (ctxt, result) ->
      let op_count = op_count + 1 in
      return ({data with ctxt; op_count}, Operation_metadata result)

let finalize_block {mode; ctxt; op_count} =
  match mode with
  | Partial_construction _ ->
      let level = Alpha_context.Level.current ctxt in
      Alpha_context.Vote.get_current_period_kind ctxt
      >>=? fun voting_period_kind ->
      let baker = Signature.Public_key_hash.zero in
      Signature.Public_key_hash.Map.fold
        (fun delegate deposit ctxt ->
          ctxt
          >>=? fun ctxt ->
          Alpha_context.Delegate.freeze_deposit ctxt delegate deposit)
        (Alpha_context.get_deposits ctxt)
        (return ctxt)
      >>=? fun ctxt ->
      let ctxt = Alpha_context.finalize ctxt in
      return
        ( ctxt,
          Apply_results.
            {
              baker;
              level;
              voting_period_kind;
              nonce_hash = None;
              consumed_gas = Z.zero;
              deactivated = [];
              balance_updates = [];
            } )
  | Partial_application {block_header; baker; block_delay} ->
      let level = Alpha_context.Level.current ctxt in
      let included_endorsements = Alpha_context.included_endorsements ctxt in
      Apply.check_minimum_endorsements
        ctxt
        block_header.protocol_data.contents
        block_delay
        included_endorsements
      >>=? fun () ->
      Alpha_context.Vote.get_current_period_kind ctxt
      >>=? fun voting_period_kind ->
      let ctxt = Alpha_context.finalize ctxt in
      return
        ( ctxt,
          Apply_results.
            {
              baker;
              level;
              voting_period_kind;
              nonce_hash = None;
              consumed_gas = Z.zero;
              deactivated = [];
              balance_updates = [];
            } )
  | Application
      { baker;
        block_delay;
        block_header = {protocol_data = {contents = protocol_data; _}; _} }
  | Full_construction {protocol_data; baker; block_delay; _} ->
      Apply.finalize_application ctxt protocol_data baker ~block_delay
      >>=? fun (ctxt, receipt) ->
      let level = Alpha_context.Level.current ctxt in
      let priority = protocol_data.priority in
      let raw_level = Alpha_context.Raw_level.to_int32 level.level in
      let fitness = Alpha_context.Fitness.current ctxt in
      let commit_message =
        Format.asprintf
          "lvl %ld, fit 1:%Ld, prio %d, %d ops"
          raw_level
          fitness
          priority
          op_count
      in
      let ctxt = Alpha_context.finalize ~commit_message ctxt in
      return (ctxt, receipt)

let compare_operations op1 op2 =
  let open Alpha_context in
  let (Operation_data op1) = op1.protocol_data in
  let (Operation_data op2) = op2.protocol_data in
  match (op1.contents, op2.contents) with
  | (Single (Endorsement _), Single (Endorsement _)) ->
      0
  | (_, Single (Endorsement _)) ->
      1
  | (Single (Endorsement _), _) ->
      -1
  | (Single (Seed_nonce_revelation _), Single (Seed_nonce_revelation _)) ->
      0
  | (_, Single (Seed_nonce_revelation _)) ->
      1
  | (Single (Seed_nonce_revelation _), _) ->
      -1
  | ( Single (Double_endorsement_evidence _),
      Single (Double_endorsement_evidence _) ) ->
      0
  | (_, Single (Double_endorsement_evidence _)) ->
      1
  | (Single (Double_endorsement_evidence _), _) ->
      -1
  | (Single (Double_baking_evidence _), Single (Double_baking_evidence _)) ->
      0
  | (_, Single (Double_baking_evidence _)) ->
      1
  | (Single (Double_baking_evidence _), _) ->
      -1
  | (Single (Activate_account _), Single (Activate_account _)) ->
      0
  | (_, Single (Activate_account _)) ->
      1
  | (Single (Activate_account _), _) ->
      -1
  | (Single (Proposals _), Single (Proposals _)) ->
      0
  | (_, Single (Proposals _)) ->
      1
  | (Single (Proposals _), _) ->
      -1
  | (Single (Ballot _), Single (Ballot _)) ->
      0
  | (_, Single (Ballot _)) ->
      1
  | (Single (Ballot _), _) ->
      -1
  (* Manager operations with smaller counter are pre-validated first. *)
  | (Single (Manager_operation op1), Single (Manager_operation op2)) ->
      Z.compare op1.counter op2.counter
  | (Cons (Manager_operation op1, _), Single (Manager_operation op2)) ->
      Z.compare op1.counter op2.counter
  | (Single (Manager_operation op1), Cons (Manager_operation op2, _)) ->
      Z.compare op1.counter op2.counter
  | (Cons (Manager_operation op1, _), Cons (Manager_operation op2, _)) ->
      Z.compare op1.counter op2.counter

let init ctxt block_header =
  let level = block_header.Block_header.level in
  let fitness = block_header.fitness in
  let timestamp = block_header.timestamp in
  let typecheck (ctxt : Alpha_context.context)
      (script : Alpha_context.Script.t) =
    Script_ir_translator.parse_script ctxt ~legacy:false script
    >>=? fun (Ex_script parsed_script, ctxt) ->
    Script_ir_translator.extract_big_map_diff
      ctxt
      Optimized
      parsed_script.storage_type
      parsed_script.storage
      ~to_duplicate:Script_ir_translator.no_big_map_id
      ~to_update:Script_ir_translator.no_big_map_id
      ~temporary:false
    >>=? fun (storage, big_map_diff, ctxt) ->
    Script_ir_translator.unparse_data
      ctxt
      Optimized
      parsed_script.storage_type
      storage
    >>=? fun (storage, ctxt) ->
    let storage =
      Alpha_context.Script.lazy_expr (Micheline.strip_locations storage)
    in
    return (({script with storage}, big_map_diff), ctxt)
  in
  Alpha_context.prepare_first_block ~typecheck ~level ~timestamp ~fitness ctxt
  >>=? fun ctxt -> return (Alpha_context.finalize ctxt)

(* Vanity nonce: 313282890 *)

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Definition block_header_data :=
  Tezos_raw_protocol_alpha.Alpha_context.Block_header.protocol_data.

Module block_header.
  Record record := {
    shell :
      Tezos_protocol_environment_alpha__Environment.Block_header.shell_header;
    protocol_data : block_header_data }.
End block_header.
Definition block_header := block_header.record.

Definition block_header_data_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    Tezos_raw_protocol_alpha.Alpha_context.Block_header.protocol_data :=
  Alpha_context.Block_header.protocol_data_encoding.

Definition block_header_metadata :=
  Tezos_raw_protocol_alpha.Apply_results.block_metadata.

Definition block_header_metadata_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    Tezos_raw_protocol_alpha.Apply_results.block_metadata :=
  Apply_results.block_metadata_encoding.

Reserved Notation "'operation_data".

Inductive operation_data_gadt : Set :=
| Operation_data : forall {kind : Set},
  Tezos_raw_protocol_alpha.Alpha_context.Operation.protocol_data kind ->
  operation_data_gadt

where "'operation_data" := (operation_data_gadt).

Definition operation_data := 'operation_data.

Definition operation_data_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.t
    Tezos_raw_protocol_alpha.Alpha_context.Operation.packed_protocol_data :=
  Alpha_context.Operation.protocol_data_encoding.

Reserved Notation "'operation_receipt".

Inductive operation_receipt_gadt : Set :=
| Operation_metadata : forall {kind : Set},
  Tezos_raw_protocol_alpha.Apply_results.operation_metadata kind ->
  operation_receipt_gadt
| No_operation_metadata : operation_receipt_gadt

where "'operation_receipt" := (operation_receipt_gadt).

Definition operation_receipt := 'operation_receipt.

Definition operation_receipt_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.t
    Tezos_raw_protocol_alpha.Apply_results.packed_operation_metadata :=
  Apply_results.operation_metadata_encoding.

Definition operation_data_and_receipt_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.t
    (Tezos_raw_protocol_alpha.Alpha_context.Operation.packed_protocol_data *
      Tezos_raw_protocol_alpha.Apply_results.packed_operation_metadata) :=
  Apply_results.operation_data_and_metadata_encoding.

Module operation.
  Record record := {
    shell : Tezos_protocol_environment_alpha__Environment.Operation.shell_header;
    protocol_data : operation_data }.
End operation.
Definition operation := operation.record.

Definition acceptable_passes
  : Tezos_raw_protocol_alpha__Alpha_context.packed_operation -> list Z :=
  Alpha_context.Operation.acceptable_passes.

Definition max_block_length : Z := Alpha_context.Block_header.max_header_length.

Definition max_operation_data_length : Z :=
  Alpha_context.Constants.max_operation_data_length.

Definition validation_passes
  : list Tezos_protocol_environment_alpha__Environment.Updater.quota :=
  let max_anonymous_operations :=
    op_plus Alpha_context.Constants.max_revelations_per_block 100 in
  cons
    {|
      Tezos_protocol_environment_alpha__Environment.Updater.quota.max_size :=
        op_star 32 1024;
      Tezos_protocol_environment_alpha__Environment.Updater.quota.max_op :=
        Some 32 |}
    (cons
      {|
        Tezos_protocol_environment_alpha__Environment.Updater.quota.max_size :=
          op_star 32 1024;
        Tezos_protocol_environment_alpha__Environment.Updater.quota.max_op :=
          None |}
      (cons
        {|
          Tezos_protocol_environment_alpha__Environment.Updater.quota.max_size :=
            op_star max_anonymous_operations 1024;
          Tezos_protocol_environment_alpha__Environment.Updater.quota.max_op :=
            Some max_anonymous_operations |}
        (cons
          {|
            Tezos_protocol_environment_alpha__Environment.Updater.quota.max_size :=
              op_star 512 1024;
            Tezos_protocol_environment_alpha__Environment.Updater.quota.max_op :=
              None |} []))).

Definition rpc_services
  : Tezos_protocol_environment_alpha__Environment.RPC_directory.directory
    Tezos_protocol_environment_alpha__Environment.Updater.rpc_context :=
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ := Alpha_services.register tt in
  Services_registration.get_rpc_services tt.

Inductive validation_mode : Set :=
| Application :
  Tezos_raw_protocol_alpha.Alpha_context.Block_header.t ->
  Tezos_raw_protocol_alpha.Alpha_context.public_key_hash ->
  Tezos_raw_protocol_alpha.Alpha_context.Period.t -> validation_mode
| Partial_application :
  Tezos_raw_protocol_alpha.Alpha_context.Block_header.t ->
  Tezos_raw_protocol_alpha.Alpha_context.public_key_hash ->
  Tezos_raw_protocol_alpha.Alpha_context.Period.t -> validation_mode
| Partial_construction :
  Tezos_protocol_environment_alpha__Environment.Block_hash.t -> validation_mode
| Full_construction :
  Tezos_protocol_environment_alpha__Environment.Block_hash.t ->
  Tezos_raw_protocol_alpha.Alpha_context.Block_header.contents ->
  Tezos_raw_protocol_alpha.Alpha_context.public_key_hash ->
  Tezos_raw_protocol_alpha.Alpha_context.Period.t -> validation_mode.

Module validation_state.
  Record record := {
    mode : validation_mode;
    chain_id : Tezos_protocol_environment_alpha__Environment.Chain_id.t;
    ctxt : Tezos_raw_protocol_alpha.Alpha_context.t;
    op_count : Z }.
End validation_state.
Definition validation_state := validation_state.record.

Definition current_context (function_parameter : validation_state)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_protocol_environment_alpha__Environment.Context.t) :=
  let '{| validation_state.ctxt := ctxt |} := function_parameter in
  __return
    (Tezos_protocol_environment_alpha__Environment.Updater.validation_result.context
      (Alpha_context.finalize None ctxt)).

Definition begin_partial_application
  (chain_id : Tezos_protocol_environment_alpha__Environment.Chain_id.t)
  (ctxt : Tezos_protocol_environment_alpha__Environment.Context.t)
  (predecessor_timestamp : Tezos_protocol_environment_alpha__Environment.Time.t)
  (predecessor_fitness : Tezos_raw_protocol_alpha.Alpha_context.Fitness.t)
  (block_header : Tezos_raw_protocol_alpha.Alpha_context.Block_header.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      validation_state) :=
  let level :=
    Tezos_protocol_environment_alpha__Environment.Block_header.shell_header.level
      (block_header.shell block_header) in
  let fitness := predecessor_fitness in
  let timestamp :=
    Tezos_protocol_environment_alpha__Environment.Block_header.shell_header.timestamp
      (block_header.shell block_header) in
  op_gtgteqquestion
    (Alpha_context.prepare ctxt level predecessor_timestamp timestamp fitness)
    (fun ctxt =>
      op_gtgteqquestion
        (Apply.begin_application ctxt chain_id block_header
          predecessor_timestamp)
        (fun function_parameter =>
          let '(ctxt, baker, block_delay) := function_parameter in
          let mode :=
            Partial_application
              {|
                validation_mode.Partial_application.block_header := block_header;
                validation_mode.Partial_application.baker :=
                  Signature.Public_key.__hash_value baker;
                validation_mode.Partial_application.block_delay := block_delay
                |} in
          __return
            {| validation_state.mode := mode;
              validation_state.chain_id := chain_id;
              validation_state.ctxt := ctxt; validation_state.op_count := 0 |})).

Definition begin_application
  (chain_id : Tezos_protocol_environment_alpha__Environment.Chain_id.t)
  (ctxt : Tezos_protocol_environment_alpha__Environment.Context.t)
  (predecessor_timestamp : Tezos_protocol_environment_alpha__Environment.Time.t)
  (predecessor_fitness : Tezos_raw_protocol_alpha.Alpha_context.Fitness.t)
  (block_header : Tezos_raw_protocol_alpha.Alpha_context.Block_header.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      validation_state) :=
  let level :=
    Tezos_protocol_environment_alpha__Environment.Block_header.shell_header.level
      (block_header.shell block_header) in
  let fitness := predecessor_fitness in
  let timestamp :=
    Tezos_protocol_environment_alpha__Environment.Block_header.shell_header.timestamp
      (block_header.shell block_header) in
  op_gtgteqquestion
    (Alpha_context.prepare ctxt level predecessor_timestamp timestamp fitness)
    (fun ctxt =>
      op_gtgteqquestion
        (Apply.begin_application ctxt chain_id block_header
          predecessor_timestamp)
        (fun function_parameter =>
          let '(ctxt, baker, block_delay) := function_parameter in
          let mode :=
            Application
              {| validation_mode.Application.block_header := block_header;
                validation_mode.Application.baker :=
                  Signature.Public_key.__hash_value baker;
                validation_mode.Application.block_delay := block_delay |} in
          __return
            {| validation_state.mode := mode;
              validation_state.chain_id := chain_id;
              validation_state.ctxt := ctxt; validation_state.op_count := 0 |})).

Definition begin_construction
  (chain_id : Tezos_protocol_environment_alpha__Environment.Chain_id.t)
  (ctxt : Tezos_protocol_environment_alpha__Environment.Context.t)
  (predecessor_timestamp : Tezos_protocol_environment_alpha__Environment.Time.t)
  (pred_level : int32)
  (pred_fitness : Tezos_raw_protocol_alpha.Alpha_context.Fitness.t)
  (predecessor : Tezos_protocol_environment_alpha__Environment.Block_hash.t)
  (timestamp : Tezos_protocol_environment_alpha__Environment.Time.t)
  (protocol_data : option block_header_data) (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      validation_state) :=
  let 'tt := function_parameter in
  let level := Int32.succ pred_level in
  let fitness := pred_fitness in
  op_gtgteqquestion
    (Alpha_context.prepare ctxt level predecessor_timestamp timestamp fitness)
    (fun ctxt =>
      op_gtgteqquestion
        match protocol_data with
        | None =>
          op_gtgteqquestion (Apply.begin_partial_construction ctxt)
            (fun ctxt =>
              let mode :=
                Partial_construction
                  {|
                    validation_mode.Partial_construction.predecessor :=
                      predecessor |} in
              __return (mode, ctxt))
        | Some proto_header =>
          op_gtgteqquestion
            (Apply.begin_full_construction ctxt predecessor_timestamp
              (Tezos_raw_protocol_alpha.Alpha_context.Block_header.protocol_data.contents
                proto_header))
            (fun function_parameter =>
              let '(ctxt, protocol_data, baker, block_delay) :=
                function_parameter in
              let mode :=
                let baker := Signature.Public_key.__hash_value baker in
                Full_construction
                  {|
                    validation_mode.Full_construction.predecessor := predecessor;
                    validation_mode.Full_construction.protocol_data :=
                      protocol_data;
                    validation_mode.Full_construction.baker := baker;
                    validation_mode.Full_construction.block_delay := block_delay
                    |} in
              __return (mode, ctxt))
        end
        (fun function_parameter =>
          let '(mode, ctxt) := function_parameter in
          __return
            {| validation_state.mode := mode;
              validation_state.chain_id := chain_id;
              validation_state.ctxt := ctxt; validation_state.op_count := 0 |})).

Definition apply_operation (function_parameter : validation_state)
  : Tezos_raw_protocol_alpha.Alpha_context.packed_operation ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (validation_state * operation_receipt)) :=
  let
    '{|
      validation_state.mode := mode;
        validation_state.chain_id := chain_id;
        validation_state.ctxt := ctxt;
        validation_state.op_count := op_count
        |} as data := function_parameter in
  fun operation =>
    match mode with
    | Partial_application _ =>
      let op_count := op_plus op_count 1 in
      __return
        ((* ❌ Record substitution not handled *)
        record_substitution, No_operation_metadata)
    | _ =>
      let '{|
        operation.shell := shell;
          operation.protocol_data := Operation_data protocol_data
          |} := operation in
      let operation :=
        {| Tezos_raw_protocol_alpha.Alpha_context.operation.shell := shell;
          Tezos_raw_protocol_alpha.Alpha_context.operation.protocol_data :=
            protocol_data |} in
      let '(predecessor, baker) :=
        match mode with
        |
          Partial_application {|
            validation_mode.Partial_application.block_header := {|
              block_header.shell := {|
                Tezos_protocol_environment_alpha__Environment.Block_header.shell_header.predecessor
                  := predecessor
                  |}
                |};
              validation_mode.Partial_application.baker := baker
              |} |
            Application {|
              validation_mode.Application.block_header := {|
                block_header.shell := {|
                  Tezos_protocol_environment_alpha__Environment.Block_header.shell_header.predecessor
                    := predecessor
                    |}
                  |};
                validation_mode.Application.baker := baker
                |} |
            Full_construction {|
              validation_mode.Full_construction.predecessor := predecessor;
                validation_mode.Full_construction.baker := baker
                |} => (predecessor, baker)
        |
          Partial_construction {|
            validation_mode.Partial_construction.predecessor := predecessor
              |} => (predecessor, Signature.Public_key_hash.zero)
        end in
      op_gtgteqquestion
        (Apply.apply_operation ctxt chain_id
          Tezos_raw_protocol_alpha.Script_ir_translator.Optimized predecessor
          baker (Alpha_context.Operation.__hash_value operation) operation)
        (fun function_parameter =>
          let '(ctxt, __result_value) := function_parameter in
          let op_count := op_plus op_count 1 in
          __return
            ((* ❌ Record substitution not handled *)
            record_substitution, (Operation_metadata __result_value)))
    end.

Definition finalize_block (function_parameter : validation_state)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_protocol_environment_alpha__Environment.Updater.validation_result *
        Tezos_raw_protocol_alpha.Apply_results.block_metadata)) :=
  let '{|
    validation_state.mode := mode;
      validation_state.ctxt := ctxt;
      validation_state.op_count := op_count
      |} := function_parameter in
  match mode with
  | Partial_construction _ =>
    let level := Alpha_context.Level.current ctxt in
    op_gtgteqquestion (Alpha_context.Vote.get_current_period_kind ctxt)
      (fun voting_period_kind =>
        let baker := Signature.Public_key_hash.zero in
        op_gtgteqquestion
          (Signature.Public_key_hash.Map.fold
            (fun delegate =>
              fun deposit =>
                fun ctxt =>
                  op_gtgteqquestion ctxt
                    (fun ctxt =>
                      Alpha_context.Delegate.freeze_deposit ctxt delegate
                        deposit)) (Alpha_context.get_deposits ctxt)
            (__return ctxt))
          (fun ctxt =>
            let ctxt := Alpha_context.finalize None ctxt in
            __return
              (ctxt,
                {|
                  Tezos_raw_protocol_alpha.Apply_results.block_metadata.baker :=
                    baker;
                  Tezos_raw_protocol_alpha.Apply_results.block_metadata.level :=
                    level;
                  Tezos_raw_protocol_alpha.Apply_results.block_metadata.voting_period_kind :=
                    voting_period_kind;
                  Tezos_raw_protocol_alpha.Apply_results.block_metadata.nonce_hash :=
                    None;
                  Tezos_raw_protocol_alpha.Apply_results.block_metadata.consumed_gas :=
                    Z.zero;
                  Tezos_raw_protocol_alpha.Apply_results.block_metadata.deactivated :=
                    [];
                  Tezos_raw_protocol_alpha.Apply_results.block_metadata.balance_updates :=
                    [] |})))
  |
    Partial_application {|
      validation_mode.Partial_application.block_header := block_header;
        validation_mode.Partial_application.baker := baker;
        validation_mode.Partial_application.block_delay := block_delay
        |} =>
    let level := Alpha_context.Level.current ctxt in
    let included_endorsements := Alpha_context.included_endorsements ctxt in
    op_gtgteqquestion
      (Apply.check_minimum_endorsements ctxt
        (Tezos_raw_protocol_alpha.Alpha_context.Block_header.protocol_data.contents
          (block_header.protocol_data block_header)) block_delay
        included_endorsements)
      (fun function_parameter =>
        let 'tt := function_parameter in
        op_gtgteqquestion (Alpha_context.Vote.get_current_period_kind ctxt)
          (fun voting_period_kind =>
            let ctxt := Alpha_context.finalize None ctxt in
            __return
              (ctxt,
                {|
                  Tezos_raw_protocol_alpha.Apply_results.block_metadata.baker :=
                    baker;
                  Tezos_raw_protocol_alpha.Apply_results.block_metadata.level :=
                    level;
                  Tezos_raw_protocol_alpha.Apply_results.block_metadata.voting_period_kind :=
                    voting_period_kind;
                  Tezos_raw_protocol_alpha.Apply_results.block_metadata.nonce_hash :=
                    None;
                  Tezos_raw_protocol_alpha.Apply_results.block_metadata.consumed_gas :=
                    Z.zero;
                  Tezos_raw_protocol_alpha.Apply_results.block_metadata.deactivated :=
                    [];
                  Tezos_raw_protocol_alpha.Apply_results.block_metadata.balance_updates :=
                    [] |})))
  |
    Application {|
      validation_mode.Application.block_header := {|
        block_header.protocol_data := {|
          Tezos_raw_protocol_alpha.Alpha_context.Block_header.protocol_data.contents
            := protocol_data
            |}
          |};
        validation_mode.Application.baker := baker;
        validation_mode.Application.block_delay := block_delay
        |} |
      Full_construction {|
        validation_mode.Full_construction.protocol_data := protocol_data;
          validation_mode.Full_construction.baker := baker;
          validation_mode.Full_construction.block_delay := block_delay
          |} =>
    op_gtgteqquestion
      (Apply.finalize_application ctxt protocol_data baker block_delay)
      (fun function_parameter =>
        let '(ctxt, receipt) := function_parameter in
        let level := Alpha_context.Level.current ctxt in
        let priority :=
          Tezos_raw_protocol_alpha.Alpha_context.Block_header.contents.priority
            protocol_data in
        let raw_level :=
          Alpha_context.Raw_level.to_int32
            (Tezos_raw_protocol_alpha.Alpha_context.Level.t.level level) in
        let fitness := Alpha_context.Fitness.current ctxt in
        let commit_message :=
          Format.asprintf
            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                "lvl " % string
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int32
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int_d
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_precision
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                    ", fit 1:" % string
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int64
                      Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int_d
                      Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
                      Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_precision
                      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                        ", prio " % string
                        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int
                          Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int_d
                          Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
                          Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_precision
                          (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                            ", " % string
                            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int
                              Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int_d
                              Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
                              Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_precision
                              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                                " ops" % string
                                Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))))))))
              "lvl %ld, fit 1:%Ld, prio %d, %d ops" % string) raw_level fitness
            priority op_count in
        let ctxt := Alpha_context.finalize (Some commit_message) ctxt in
        __return (ctxt, receipt))
  end.

Definition compare_operations
  (op1 : Tezos_raw_protocol_alpha.Alpha_context.packed_operation)
  (op2 : Tezos_raw_protocol_alpha.Alpha_context.packed_operation) : Z :=
  let 'Tezos_raw_protocol_alpha.Alpha_context.Operation_data op1 :=
    Tezos_raw_protocol_alpha.Alpha_context.packed_operation.protocol_data op1 in
  let 'Tezos_raw_protocol_alpha.Alpha_context.Operation_data op2 :=
    Tezos_raw_protocol_alpha.Alpha_context.packed_operation.protocol_data op2 in
  match
    ((Tezos_raw_protocol_alpha.Alpha_context.protocol_data.contents op1),
      (Tezos_raw_protocol_alpha.Alpha_context.protocol_data.contents op2)) with
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Single
      (Tezos_raw_protocol_alpha.Alpha_context.Endorsement _),
      Tezos_raw_protocol_alpha.Alpha_context.Single
        (Tezos_raw_protocol_alpha.Alpha_context.Endorsement _)) => 0
  |
    (_,
      Tezos_raw_protocol_alpha.Alpha_context.Single
        (Tezos_raw_protocol_alpha.Alpha_context.Endorsement _)) => 1
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Single
      (Tezos_raw_protocol_alpha.Alpha_context.Endorsement _), _) => (-1)
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Single
      (Tezos_raw_protocol_alpha.Alpha_context.Seed_nonce_revelation _),
      Tezos_raw_protocol_alpha.Alpha_context.Single
        (Tezos_raw_protocol_alpha.Alpha_context.Seed_nonce_revelation _)) => 0
  |
    (_,
      Tezos_raw_protocol_alpha.Alpha_context.Single
        (Tezos_raw_protocol_alpha.Alpha_context.Seed_nonce_revelation _)) => 1
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Single
      (Tezos_raw_protocol_alpha.Alpha_context.Seed_nonce_revelation _), _) =>
    (-1)
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Single
      (Tezos_raw_protocol_alpha.Alpha_context.Double_endorsement_evidence _),
      Tezos_raw_protocol_alpha.Alpha_context.Single
        (Tezos_raw_protocol_alpha.Alpha_context.Double_endorsement_evidence _))
    => 0
  |
    (_,
      Tezos_raw_protocol_alpha.Alpha_context.Single
        (Tezos_raw_protocol_alpha.Alpha_context.Double_endorsement_evidence _))
    => 1
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Single
      (Tezos_raw_protocol_alpha.Alpha_context.Double_endorsement_evidence _), _)
    => (-1)
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Single
      (Tezos_raw_protocol_alpha.Alpha_context.Double_baking_evidence _),
      Tezos_raw_protocol_alpha.Alpha_context.Single
        (Tezos_raw_protocol_alpha.Alpha_context.Double_baking_evidence _)) => 0
  |
    (_,
      Tezos_raw_protocol_alpha.Alpha_context.Single
        (Tezos_raw_protocol_alpha.Alpha_context.Double_baking_evidence _)) => 1
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Single
      (Tezos_raw_protocol_alpha.Alpha_context.Double_baking_evidence _), _) =>
    (-1)
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Single
      (Tezos_raw_protocol_alpha.Alpha_context.Activate_account _),
      Tezos_raw_protocol_alpha.Alpha_context.Single
        (Tezos_raw_protocol_alpha.Alpha_context.Activate_account _)) => 0
  |
    (_,
      Tezos_raw_protocol_alpha.Alpha_context.Single
        (Tezos_raw_protocol_alpha.Alpha_context.Activate_account _)) => 1
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Single
      (Tezos_raw_protocol_alpha.Alpha_context.Activate_account _), _) => (-1)
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Single
      (Tezos_raw_protocol_alpha.Alpha_context.Proposals _),
      Tezos_raw_protocol_alpha.Alpha_context.Single
        (Tezos_raw_protocol_alpha.Alpha_context.Proposals _)) => 0
  |
    (_,
      Tezos_raw_protocol_alpha.Alpha_context.Single
        (Tezos_raw_protocol_alpha.Alpha_context.Proposals _)) => 1
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Single
      (Tezos_raw_protocol_alpha.Alpha_context.Proposals _), _) => (-1)
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Single
      (Tezos_raw_protocol_alpha.Alpha_context.Ballot _),
      Tezos_raw_protocol_alpha.Alpha_context.Single
        (Tezos_raw_protocol_alpha.Alpha_context.Ballot _)) => 0
  |
    (_,
      Tezos_raw_protocol_alpha.Alpha_context.Single
        (Tezos_raw_protocol_alpha.Alpha_context.Ballot _)) => 1
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Single
      (Tezos_raw_protocol_alpha.Alpha_context.Ballot _), _) => (-1)
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Single
      (Tezos_raw_protocol_alpha.Alpha_context.Manager_operation op1),
      Tezos_raw_protocol_alpha.Alpha_context.Single
        (Tezos_raw_protocol_alpha.Alpha_context.Manager_operation op2)) =>
    Z.compare
      (Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.counter
        op1)
      (Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.counter
        op2)
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Cons
      (Tezos_raw_protocol_alpha.Alpha_context.Manager_operation op1) _,
      Tezos_raw_protocol_alpha.Alpha_context.Single
        (Tezos_raw_protocol_alpha.Alpha_context.Manager_operation op2)) =>
    Z.compare
      (Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.counter
        op1)
      (Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.counter
        op2)
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Single
      (Tezos_raw_protocol_alpha.Alpha_context.Manager_operation op1),
      Tezos_raw_protocol_alpha.Alpha_context.Cons
        (Tezos_raw_protocol_alpha.Alpha_context.Manager_operation op2) _) =>
    Z.compare
      (Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.counter
        op1)
      (Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.counter
        op2)
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Cons
      (Tezos_raw_protocol_alpha.Alpha_context.Manager_operation op1) _,
      Tezos_raw_protocol_alpha.Alpha_context.Cons
        (Tezos_raw_protocol_alpha.Alpha_context.Manager_operation op2) _) =>
    Z.compare
      (Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.counter
        op1)
      (Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.counter
        op2)
  end.

Definition init
  (ctxt : Tezos_protocol_environment_alpha__Environment.Context.t)
  (block_header :
    Tezos_protocol_environment_alpha__Environment.Block_header.shell_header)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_protocol_environment_alpha__Environment.Updater.validation_result) :=
  let level :=
    Tezos_protocol_environment_alpha__Environment.Block_header.shell_header.level
      block_header in
  let fitness :=
    Tezos_protocol_environment_alpha__Environment.Block_header.shell_header.fitness
      block_header in
  let timestamp :=
    Tezos_protocol_environment_alpha__Environment.Block_header.shell_header.timestamp
      block_header in
  let typecheck
    (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context) (script :
    Tezos_raw_protocol_alpha.Alpha_context.Script.t)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        ((Tezos_raw_protocol_alpha.Alpha_context.Script.t *
          option Tezos_raw_protocol_alpha.Alpha_context.Contract.big_map_diff) *
          Tezos_raw_protocol_alpha.Alpha_context.context)) :=
    op_gtgteqquestion (Script_ir_translator.parse_script None ctxt false script)
      (fun function_parameter =>
        let
          '(Tezos_raw_protocol_alpha.Script_ir_translator.Ex_script
            parsed_script, ctxt) := function_parameter in
        op_gtgteqquestion
          (Script_ir_translator.extract_big_map_diff ctxt
            Tezos_raw_protocol_alpha.Script_ir_translator.Optimized false
            Script_ir_translator.no_big_map_id
            Script_ir_translator.no_big_map_id
            (Tezos_raw_protocol_alpha.Script_typed_ir.script.storage_type
              parsed_script)
            (Tezos_raw_protocol_alpha.Script_typed_ir.script.storage
              parsed_script))
          (fun function_parameter =>
            let '(storage, big_map_diff, ctxt) := function_parameter in
            op_gtgteqquestion
              (Script_ir_translator.unparse_data ctxt
                Tezos_raw_protocol_alpha.Script_ir_translator.Optimized
                (Tezos_raw_protocol_alpha.Script_typed_ir.script.storage_type
                  parsed_script) storage)
              (fun function_parameter =>
                let '(storage, ctxt) := function_parameter in
                let storage :=
                  Alpha_context.Script.lazy_expr
                    (Micheline.strip_locations storage) in
                __return
                  (((* ❌ Record substitution not handled *)
                  record_substitution, big_map_diff), ctxt)))) in
  op_gtgteqquestion
    (Alpha_context.prepare_first_block ctxt typecheck level timestamp fitness)
    (fun ctxt => __return (Alpha_context.finalize None ctxt)).

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

(** Tezos Protocol Implementation - Protocol Signature Instance *)

type validation_mode =
  | Application of {
      block_header : Alpha_context.Block_header.t;
      baker : Alpha_context.public_key_hash;
      block_delay : Alpha_context.Period.t;
    }
  | Partial_application of {
      block_header : Alpha_context.Block_header.t;
      baker : Alpha_context.public_key_hash;
      block_delay : Alpha_context.Period.t;
    }
  | Partial_construction of {predecessor : Block_hash.t}
  | Full_construction of {
      predecessor : Block_hash.t;
      protocol_data : Alpha_context.Block_header.contents;
      baker : Alpha_context.public_key_hash;
      block_delay : Alpha_context.Period.t;
    }

type validation_state = {
  mode : validation_mode;
  chain_id : Chain_id.t;
  ctxt : Alpha_context.t;
  op_count : int;
}

type operation_data = Alpha_context.packed_protocol_data

type operation = Alpha_context.packed_operation = {
  shell : Operation.shell_header;
  protocol_data : operation_data;
}

include
  Updater.PROTOCOL
    with type block_header_data = Alpha_context.Block_header.protocol_data
     and type block_header_metadata = Apply_results.block_metadata
     and type block_header = Alpha_context.Block_header.t
     and type operation_data := operation_data
     and type operation_receipt = Apply_results.packed_operation_metadata
     and type operation := operation
     and type validation_state := validation_state

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Inductive validation_mode : Set :=
| Application :
  Tezos_raw_protocol_alpha.Alpha_context.Block_header.t ->
  Tezos_raw_protocol_alpha.Alpha_context.public_key_hash ->
  Tezos_raw_protocol_alpha.Alpha_context.Period.t -> validation_mode
| Partial_application :
  Tezos_raw_protocol_alpha.Alpha_context.Block_header.t ->
  Tezos_raw_protocol_alpha.Alpha_context.public_key_hash ->
  Tezos_raw_protocol_alpha.Alpha_context.Period.t -> validation_mode
| Partial_construction :
  Tezos_protocol_environment_alpha__Environment.Block_hash.t -> validation_mode
| Full_construction :
  Tezos_protocol_environment_alpha__Environment.Block_hash.t ->
  Tezos_raw_protocol_alpha.Alpha_context.Block_header.contents ->
  Tezos_raw_protocol_alpha.Alpha_context.public_key_hash ->
  Tezos_raw_protocol_alpha.Alpha_context.Period.t -> validation_mode.

Module validation_state.
  Record record := {
    mode : validation_mode;
    chain_id : Tezos_protocol_environment_alpha__Environment.Chain_id.t;
    ctxt : Tezos_raw_protocol_alpha.Alpha_context.t;
    op_count : Z }.
End validation_state.
Definition validation_state := validation_state.record.

Definition operation_data :=
  Tezos_raw_protocol_alpha.Alpha_context.packed_protocol_data.

Module operation.
  Record record := {
    shell : Tezos_protocol_environment_alpha__Environment.Operation.shell_header;
    protocol_data : operation_data }.
End operation.
Definition operation := operation.record.

Parameter max_block_length : Z.

Parameter max_operation_data_length : Z.

Parameter validation_passes :
  list Tezos_protocol_environment_alpha__Environment.Updater.quota.

Definition block_header_data :=
  Tezos_raw_protocol_alpha.Alpha_context.Block_header.protocol_data.

Parameter block_header_data_encoding :
  Tezos_protocol_environment_alpha__Environment.Data_encoding.t
    block_header_data.

Definition block_header :=
  Tezos_raw_protocol_alpha.Alpha_context.Block_header.t.

Definition block_header_metadata :=
  Tezos_raw_protocol_alpha.Apply_results.block_metadata.

Parameter block_header_metadata_encoding :
  Tezos_protocol_environment_alpha__Environment.Data_encoding.t
    block_header_metadata.

Definition operation_receipt :=
  Tezos_raw_protocol_alpha.Apply_results.packed_operation_metadata.

Parameter operation_data_encoding :
  Tezos_protocol_environment_alpha__Environment.Data_encoding.t operation_data.

Parameter operation_receipt_encoding :
  Tezos_protocol_environment_alpha__Environment.Data_encoding.t
    operation_receipt.

Parameter operation_data_and_receipt_encoding :
  Tezos_protocol_environment_alpha__Environment.Data_encoding.t
    (operation_data * operation_receipt).

Parameter acceptable_passes : operation -> list Z.

Parameter compare_operations : operation -> operation -> Z.

Parameter current_context :
  validation_state ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_protocol_environment_alpha__Environment.Context.t).

Parameter begin_partial_application :
  Tezos_protocol_environment_alpha__Environment.Chain_id.t ->
  Tezos_protocol_environment_alpha__Environment.Context.t ->
  Tezos_protocol_environment_alpha__Environment.Time.t ->
  Tezos_protocol_environment_alpha__Environment.Fitness.t -> block_header ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      validation_state).

Parameter begin_application :
  Tezos_protocol_environment_alpha__Environment.Chain_id.t ->
  Tezos_protocol_environment_alpha__Environment.Context.t ->
  Tezos_protocol_environment_alpha__Environment.Time.t ->
  Tezos_protocol_environment_alpha__Environment.Fitness.t -> block_header ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      validation_state).

Parameter begin_construction :
  Tezos_protocol_environment_alpha__Environment.Chain_id.t ->
  Tezos_protocol_environment_alpha__Environment.Context.t ->
  Tezos_protocol_environment_alpha__Environment.Time.t ->
  Tezos_protocol_environment_alpha__Environment.Int32.t ->
  Tezos_protocol_environment_alpha__Environment.Fitness.t ->
  Tezos_protocol_environment_alpha__Environment.Block_hash.t ->
  Tezos_protocol_environment_alpha__Environment.Time.t ->
  option block_header_data -> unit ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      validation_state).

Parameter apply_operation :
  validation_state -> operation ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (validation_state * operation_receipt)).

Parameter finalize_block :
  validation_state ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_protocol_environment_alpha__Environment.Updater.validation_result *
        block_header_metadata)).

Parameter rpc_services :
  Tezos_protocol_environment_alpha__Environment.RPC_directory.t
    Tezos_protocol_environment_alpha__Environment.Updater.rpc_context.

Parameter init :
  Tezos_protocol_environment_alpha__Environment.Context.t ->
  Tezos_protocol_environment_alpha__Environment.Block_header.shell_header ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_protocol_environment_alpha__Environment.Updater.validation_result).

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

(* Tezos Protocol Implementation - Low level Repr. of Managers' keys *)

type manager_key =
  | Hash of Signature.Public_key_hash.t
  | Public_key of Signature.Public_key.t

type t = manager_key

open Data_encoding

let hash_case tag =
  case
    tag
    ~title:"Public_key_hash"
    Signature.Public_key_hash.encoding
    (function Hash hash -> Some hash | _ -> None)
    (fun hash -> Hash hash)

let pubkey_case tag =
  case
    tag
    ~title:"Public_key"
    Signature.Public_key.encoding
    (function Public_key hash -> Some hash | _ -> None)
    (fun hash -> Public_key hash)

let encoding = union [hash_case (Tag 0); pubkey_case (Tag 1)]

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Inductive manager_key : Set :=
| Hash :
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  manager_key
| Public_key :
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t ->
  manager_key.

Definition t := manager_key.

Import Data_encoding.

Definition hash_case
  (tag : Tezos_protocol_environment_alpha__Environment.Data_encoding.case_tag)
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.case manager_key :=
  __case_value "Public_key_hash" % string None tag
    Signature.Public_key_hash.encoding
    (fun function_parameter =>
      match function_parameter with
      | Hash __hash_value => Some __hash_value
      | _ => None
      end) (fun __hash_value => Hash __hash_value).

Definition pubkey_case
  (tag : Tezos_protocol_environment_alpha__Environment.Data_encoding.case_tag)
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.case manager_key :=
  __case_value "Public_key" % string None tag Signature.Public_key.encoding
    (fun function_parameter =>
      match function_parameter with
      | Public_key __hash_value => Some __hash_value
      | _ => None
      end) (fun __hash_value => Public_key __hash_value).

Definition encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    manager_key :=
  union None
    (cons
      (hash_case
        (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag 0))
      (cons
        (pubkey_case
          (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag 1))
        [])).

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

(* Tezos Protocol Implementation - Low level Repr. of Managers' keys *)

(** The public key of the manager of a contract is reveled only after the
    first operation. At Origination time, the manager provides only the hash
    of its public key that is stored in the contract. When the public key
    is actually reveeld, the public key instead of the hash of the key *)
type manager_key =
  | Hash of Signature.Public_key_hash.t
  | Public_key of Signature.Public_key.t

type t = manager_key

val encoding : t Data_encoding.encoding

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Inductive manager_key : Set :=
| Hash :
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  manager_key
| Public_key :
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t ->
  manager_key.

Definition t := manager_key.

Parameter encoding :
  Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding t.

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Alpha_context
open Gas

module Cost_of = struct
  let log2 =
    let rec help acc = function 0 -> acc | n -> help (acc + 1) (n / 2) in
    help 1

  let z_bytes (z : Z.t) =
    let bits = Z.numbits z in
    (7 + bits) / 8

  let int_bytes (z : 'a Script_int.num) = z_bytes (Script_int.to_zint z)

  let timestamp_bytes (t : Script_timestamp.t) =
    let z = Script_timestamp.to_zint t in
    z_bytes z

  (* For now, returns size in bytes, but this could get more complicated... *)
  let rec size_of_comparable :
      type a b. (a, b) Script_typed_ir.comparable_struct -> a -> int =
   fun wit v ->
    match wit with
    | Int_key _ ->
        int_bytes v
    | Nat_key _ ->
        int_bytes v
    | String_key _ ->
        String.length v
    | Bytes_key _ ->
        MBytes.length v
    | Bool_key _ ->
        8
    | Key_hash_key _ ->
        Signature.Public_key_hash.size
    | Timestamp_key _ ->
        timestamp_bytes v
    | Address_key _ ->
        Signature.Public_key_hash.size
    | Mutez_key _ ->
        8
    | Pair_key ((l, _), (r, _), _) ->
        let (lval, rval) = v in
        size_of_comparable l lval + size_of_comparable r rval

  let string length = alloc_bytes_cost length

  let bytes length = alloc_mbytes_cost length

  let manager_operation = step_cost 10_000

  module Legacy = struct
    let zint z = alloc_bits_cost (Z.numbits z)

    let set_to_list : type item. item Script_typed_ir.set -> cost =
     fun (module Box) -> alloc_cost @@ Pervasives.(Box.size * 2)

    let map_to_list : type key value. (key, value) Script_typed_ir.map -> cost
        =
     fun (module Box) ->
      let size = snd Box.boxed in
      3 *@ alloc_cost size

    let z_to_int64 = step_cost 2 +@ alloc_cost 1

    let hash data len = (10 *@ step_cost (MBytes.length data)) +@ bytes len

    let set_access : type elt. elt -> elt Script_typed_ir.set -> int =
     fun _key (module Box) -> log2 @@ Box.size

    let set_update key _presence set = set_access key set *@ alloc_cost 3
  end

  module Interpreter = struct
    let cycle = atomic_step_cost 10

    let nop = free

    let stack_op = atomic_step_cost 10

    let push = atomic_step_cost 10

    let wrap = atomic_step_cost 10

    let variant_no_data = atomic_step_cost 10

    let branch = atomic_step_cost 10

    let pair = atomic_step_cost 10

    let pair_access = atomic_step_cost 10

    let cons = atomic_step_cost 10

    let loop_size = atomic_step_cost 5

    let loop_cycle = atomic_step_cost 10

    let loop_iter = atomic_step_cost 20

    let loop_map = atomic_step_cost 30

    let empty_set = atomic_step_cost 10

    let set_to_list : type elt. elt Script_typed_ir.set -> cost =
     fun (module Box) -> atomic_step_cost (Box.size * 20)

    let set_mem : type elt. elt -> elt Script_typed_ir.set -> cost =
     fun elt (module Box) ->
      let elt_bytes = size_of_comparable Box.elt_ty elt in
      atomic_step_cost ((1 + (elt_bytes / 82)) * log2 Box.size)

    let set_update : type elt. elt -> bool -> elt Script_typed_ir.set -> cost =
     fun elt _ (module Box) ->
      let elt_bytes = size_of_comparable Box.elt_ty elt in
      atomic_step_cost ((1 + (elt_bytes / 82)) * log2 Box.size)

    let set_size = atomic_step_cost 10

    let empty_map = atomic_step_cost 10

    let map_to_list : type key value. (key, value) Script_typed_ir.map -> cost
        =
     fun (module Box) ->
      let size = snd Box.boxed in
      atomic_step_cost (size * 20)

    let map_access :
        type key value. key -> (key, value) Script_typed_ir.map -> cost =
     fun key (module Box) ->
      let map_card = snd Box.boxed in
      let key_bytes = size_of_comparable Box.key_ty key in
      atomic_step_cost ((1 + (key_bytes / 70)) * log2 map_card)

    let map_mem = map_access

    let map_get = map_access

    let map_update :
        type key value.
        key -> value option -> (key, value) Script_typed_ir.map -> cost =
     fun key _value (module Box) ->
      let map_card = snd Box.boxed in
      let key_bytes = size_of_comparable Box.key_ty key in
      atomic_step_cost ((1 + (key_bytes / 38)) * log2 map_card)

    let map_size = atomic_step_cost 10

    let add_timestamp (t1 : Script_timestamp.t) (t2 : 'a Script_int.num) =
      let bytes1 = timestamp_bytes t1 in
      let bytes2 = int_bytes t2 in
      atomic_step_cost (51 + (Compare.Int.max bytes1 bytes2 / 62))

    let sub_timestamp = add_timestamp

    let diff_timestamps (t1 : Script_timestamp.t) (t2 : Script_timestamp.t) =
      let bytes1 = timestamp_bytes t1 in
      let bytes2 = timestamp_bytes t2 in
      atomic_step_cost (51 + (Compare.Int.max bytes1 bytes2 / 62))

    let rec concat_loop l acc =
      match l with [] -> 30 | _ :: tl -> concat_loop tl (acc + 30)

    let concat_string string_list =
      atomic_step_cost (concat_loop string_list 0)

    let slice_string string_length =
      atomic_step_cost (40 + (string_length / 70))

    let concat_bytes bytes_list = atomic_step_cost (concat_loop bytes_list 0)

    let int64_op = atomic_step_cost 61

    let z_to_int64 = atomic_step_cost 20

    let int64_to_z = atomic_step_cost 20

    let bool_binop _ _ = atomic_step_cost 10

    let bool_unop _ = atomic_step_cost 10

    let abs int = atomic_step_cost (61 + (int_bytes int / 70))

    let int _int = free

    let neg = abs

    let add i1 i2 =
      atomic_step_cost
        (51 + (Compare.Int.max (int_bytes i1) (int_bytes i2) / 62))

    let sub = add

    let mul i1 i2 =
      let bytes = Compare.Int.max (int_bytes i1) (int_bytes i2) in
      atomic_step_cost (51 + (bytes / 6 * log2 bytes))

    let indic_lt x y = if Compare.Int.(x < y) then 1 else 0

    let div i1 i2 =
      let bytes1 = int_bytes i1 in
      let bytes2 = int_bytes i2 in
      let cost = indic_lt bytes2 bytes1 * (bytes1 - bytes2) * bytes2 in
      atomic_step_cost (51 + (cost / 3151))

    let shift_left _i _shift_bits = atomic_step_cost 30

    let shift_right _i _shift_bits = atomic_step_cost 30

    let logor i1 i2 =
      let bytes1 = int_bytes i1 in
      let bytes2 = int_bytes i2 in
      atomic_step_cost (51 + (Compare.Int.max bytes1 bytes2 / 70))

    let logand i1 i2 =
      let bytes1 = int_bytes i1 in
      let bytes2 = int_bytes i2 in
      atomic_step_cost (51 + (Compare.Int.min bytes1 bytes2 / 70))

    let logxor = logor

    let lognot i = atomic_step_cost (51 + (int_bytes i / 20))

    let exec = atomic_step_cost 10

    let compare_bool _ _ = atomic_step_cost 30

    let compare_string s1 s2 =
      let bytes1 = String.length s1 in
      let bytes2 = String.length s2 in
      atomic_step_cost (30 + (Compare.Int.min bytes1 bytes2 / 123))

    let compare_bytes b1 b2 =
      let bytes1 = MBytes.length b1 in
      let bytes2 = MBytes.length b2 in
      atomic_step_cost (30 + (Compare.Int.min bytes1 bytes2 / 123))

    let compare_tez _ _ = atomic_step_cost 30

    let compare_zint i1 i2 =
      atomic_step_cost
        (51 + (Compare.Int.min (int_bytes i1) (int_bytes i2) / 82))

    let compare_key_hash _ _ = atomic_step_cost 92

    let compare_timestamp t1 t2 =
      let bytes1 = timestamp_bytes t1 in
      let bytes2 = timestamp_bytes t2 in
      atomic_step_cost (51 + (Compare.Int.min bytes1 bytes2 / 82))

    let compare_address _ _ = atomic_step_cost 92

    let compare_res = atomic_step_cost 30

    let unpack_failed bytes =
      (* We cannot instrument failed deserialization,
         so we take worst case fees: a set of size 1 bytes values. *)
      let len = MBytes.length bytes in
      (len *@ alloc_mbytes_cost 1)
      +@ (len *@ (log2 len *@ (alloc_cost 3 +@ step_cost 1)))

    let address = atomic_step_cost 10

    let contract = step_cost 10000

    let transfer = step_cost 10

    let create_account = step_cost 10

    let create_contract = step_cost 10

    let implicit_account = step_cost 10

    let set_delegate = step_cost 10 +@ write_bytes_cost (Z.of_int 32)

    let balance = atomic_step_cost 10

    let now = atomic_step_cost 10

    let check_signature_secp256k1 bytes = atomic_step_cost (10342 + (bytes / 5))

    let check_signature_ed25519 bytes = atomic_step_cost (36864 + (bytes / 5))

    let check_signature_p256 bytes = atomic_step_cost (36864 + (bytes / 5))

    let check_signature (pkey : Signature.public_key) bytes =
      match pkey with
      | Ed25519 _ ->
          check_signature_ed25519 (MBytes.length bytes)
      | Secp256k1 _ ->
          check_signature_secp256k1 (MBytes.length bytes)
      | P256 _ ->
          check_signature_p256 (MBytes.length bytes)

    let hash_key = atomic_step_cost 30

    let hash_blake2b b = atomic_step_cost (102 + (MBytes.length b / 5))

    let hash_sha256 b = atomic_step_cost (409 + MBytes.length b)

    let hash_sha512 b =
      let bytes = MBytes.length b in
      atomic_step_cost (409 + ((bytes lsr 1) + (bytes lsr 4)))

    let steps_to_quota = atomic_step_cost 10

    let source = atomic_step_cost 10

    let self = atomic_step_cost 10

    let amount = atomic_step_cost 10

    let chain_id = step_cost 1

    let stack_n_op n =
      atomic_step_cost (20 + ((n lsr 1) + (n lsr 2) + (n lsr 4)))

    let apply = alloc_cost 8 +@ step_cost 1

    let rec compare :
        type a s. (a, s) Script_typed_ir.comparable_struct -> a -> a -> cost =
     fun ty x y ->
      match ty with
      | Bool_key _ ->
          compare_bool x y
      | String_key _ ->
          compare_string x y
      | Bytes_key _ ->
          compare_bytes x y
      | Mutez_key _ ->
          compare_tez x y
      | Int_key _ ->
          compare_zint x y
      | Nat_key _ ->
          compare_zint x y
      | Key_hash_key _ ->
          compare_key_hash x y
      | Timestamp_key _ ->
          compare_timestamp x y
      | Address_key _ ->
          compare_address x y
      | Pair_key ((tl, _), (tr, _), _) ->
          (* Reasonable over-approximation of the cost of lexicographic comparison. *)
          let (xl, xr) = x and (yl, yr) = y in
          compare tl xl yl +@ compare tr xr yr
  end

  module Typechecking = struct
    let cycle = step_cost 1

    let bool = free

    let unit = free

    let string = string

    let bytes = bytes

    let z = Legacy.zint

    let int_of_string str =
      alloc_cost @@ Pervasives.( / ) (String.length str) 5

    let tez = step_cost 1 +@ alloc_cost 1

    let string_timestamp = step_cost 3 +@ alloc_cost 3

    let key = step_cost 3 +@ alloc_cost 3

    let key_hash = step_cost 1 +@ alloc_cost 1

    let signature = step_cost 1 +@ alloc_cost 1

    let chain_id = step_cost 1 +@ alloc_cost 1

    let contract = step_cost 5

    let get_script = step_cost 20 +@ alloc_cost 5

    let contract_exists = step_cost 15 +@ alloc_cost 5

    let pair = alloc_cost 2

    let union = alloc_cost 1

    let lambda = alloc_cost 5 +@ step_cost 3

    let some = alloc_cost 1

    let none = alloc_cost 0

    let list_element = alloc_cost 2 +@ step_cost 1

    let set_element size = log2 size *@ (alloc_cost 3 +@ step_cost 2)

    let map_element size = log2 size *@ (alloc_cost 4 +@ step_cost 2)

    let primitive_type = alloc_cost 1

    let one_arg_type = alloc_cost 2

    let two_arg_type = alloc_cost 3

    let operation b = bytes b

    let type_ nb_args = alloc_cost (nb_args + 1)

    (* Cost of parsing instruction, is cost of allocation of
       constructor + cost of contructor parameters + cost of
       allocation on the stack type *)
    let instr : type b a. (b, a) Script_typed_ir.instr -> cost =
     fun i ->
      let open Script_typed_ir in
      alloc_cost 1
      +@
      (* cost of allocation of constructor *)
      match i with
      | Drop ->
          alloc_cost 0
      | Dup ->
          alloc_cost 1
      | Swap ->
          alloc_cost 0
      | Const _ ->
          alloc_cost 1
      | Cons_pair ->
          alloc_cost 2
      | Car ->
          alloc_cost 1
      | Cdr ->
          alloc_cost 1
      | Cons_some ->
          alloc_cost 2
      | Cons_none _ ->
          alloc_cost 3
      | If_none _ ->
          alloc_cost 2
      | Left ->
          alloc_cost 3
      | Right ->
          alloc_cost 3
      | If_left _ ->
          alloc_cost 2
      | Cons_list ->
          alloc_cost 1
      | Nil ->
          alloc_cost 1
      | If_cons _ ->
          alloc_cost 2
      | List_map _ ->
          alloc_cost 5
      | List_iter _ ->
          alloc_cost 4
      | List_size ->
          alloc_cost 1
      | Empty_set _ ->
          alloc_cost 1
      | Set_iter _ ->
          alloc_cost 4
      | Set_mem ->
          alloc_cost 1
      | Set_update ->
          alloc_cost 1
      | Set_size ->
          alloc_cost 1
      | Empty_map _ ->
          alloc_cost 2
      | Map_map _ ->
          alloc_cost 5
      | Map_iter _ ->
          alloc_cost 4
      | Map_mem ->
          alloc_cost 1
      | Map_get ->
          alloc_cost 1
      | Map_update ->
          alloc_cost 1
      | Map_size ->
          alloc_cost 1
      | Empty_big_map _ ->
          alloc_cost 2
      | Big_map_mem ->
          alloc_cost 1
      | Big_map_get ->
          alloc_cost 1
      | Big_map_update ->
          alloc_cost 1
      | Concat_string ->
          alloc_cost 1
      | Concat_string_pair ->
          alloc_cost 1
      | Concat_bytes ->
          alloc_cost 1
      | Concat_bytes_pair ->
          alloc_cost 1
      | Slice_string ->
          alloc_cost 1
      | Slice_bytes ->
          alloc_cost 1
      | String_size ->
          alloc_cost 1
      | Bytes_size ->
          alloc_cost 1
      | Add_seconds_to_timestamp ->
          alloc_cost 1
      | Add_timestamp_to_seconds ->
          alloc_cost 1
      | Sub_timestamp_seconds ->
          alloc_cost 1
      | Diff_timestamps ->
          alloc_cost 1
      | Add_tez ->
          alloc_cost 1
      | Sub_tez ->
          alloc_cost 1
      | Mul_teznat ->
          alloc_cost 1
      | Mul_nattez ->
          alloc_cost 1
      | Ediv_teznat ->
          alloc_cost 1
      | Ediv_tez ->
          alloc_cost 1
      | Or ->
          alloc_cost 1
      | And ->
          alloc_cost 1
      | Xor ->
          alloc_cost 1
      | Not ->
          alloc_cost 1
      | Is_nat ->
          alloc_cost 1
      | Neg_nat ->
          alloc_cost 1
      | Neg_int ->
          alloc_cost 1
      | Abs_int ->
          alloc_cost 1
      | Int_nat ->
          alloc_cost 1
      | Add_intint ->
          alloc_cost 1
      | Add_intnat ->
          alloc_cost 1
      | Add_natint ->
          alloc_cost 1
      | Add_natnat ->
          alloc_cost 1
      | Sub_int ->
          alloc_cost 1
      | Mul_intint ->
          alloc_cost 1
      | Mul_intnat ->
          alloc_cost 1
      | Mul_natint ->
          alloc_cost 1
      | Mul_natnat ->
          alloc_cost 1
      | Ediv_intint ->
          alloc_cost 1
      | Ediv_intnat ->
          alloc_cost 1
      | Ediv_natint ->
          alloc_cost 1
      | Ediv_natnat ->
          alloc_cost 1
      | Lsl_nat ->
          alloc_cost 1
      | Lsr_nat ->
          alloc_cost 1
      | Or_nat ->
          alloc_cost 1
      | And_nat ->
          alloc_cost 1
      | And_int_nat ->
          alloc_cost 1
      | Xor_nat ->
          alloc_cost 1
      | Not_nat ->
          alloc_cost 1
      | Not_int ->
          alloc_cost 1
      | Seq _ ->
          alloc_cost 8
      | If _ ->
          alloc_cost 8
      | Loop _ ->
          alloc_cost 4
      | Loop_left _ ->
          alloc_cost 5
      | Dip _ ->
          alloc_cost 4
      | Exec ->
          alloc_cost 1
      | Apply _ ->
          alloc_cost 1
      | Lambda _ ->
          alloc_cost 2
      | Failwith _ ->
          alloc_cost 1
      | Nop ->
          alloc_cost 0
      | Compare _ ->
          alloc_cost 1
      | Eq ->
          alloc_cost 1
      | Neq ->
          alloc_cost 1
      | Lt ->
          alloc_cost 1
      | Gt ->
          alloc_cost 1
      | Le ->
          alloc_cost 1
      | Ge ->
          alloc_cost 1
      | Address ->
          alloc_cost 1
      | Contract _ ->
          alloc_cost 2
      | Transfer_tokens ->
          alloc_cost 1
      | Create_account ->
          alloc_cost 2
      | Implicit_account ->
          alloc_cost 1
      | Create_contract _ ->
          alloc_cost 8
      (* Deducted the cost of removed arguments manager, spendable and delegatable:
           - manager: key_hash = 1
           - spendable: bool = 0
           - delegatable: bool = 0
        *)
      | Create_contract_2 _ ->
          alloc_cost 7
      | Set_delegate ->
          alloc_cost 1
      | Now ->
          alloc_cost 1
      | Balance ->
          alloc_cost 1
      | Check_signature ->
          alloc_cost 1
      | Hash_key ->
          alloc_cost 1
      | Pack _ ->
          alloc_cost 2
      | Unpack _ ->
          alloc_cost 2
      | Blake2b ->
          alloc_cost 1
      | Sha256 ->
          alloc_cost 1
      | Sha512 ->
          alloc_cost 1
      | Steps_to_quota ->
          alloc_cost 1
      | Source ->
          alloc_cost 1
      | Sender ->
          alloc_cost 1
      | Self _ ->
          alloc_cost 2
      | Amount ->
          alloc_cost 1
      | Dig (n, _) ->
          n *@ alloc_cost 1 (* _ is a unary development of n *)
      | Dug (n, _) ->
          n *@ alloc_cost 1
      | Dipn (n, _, _) ->
          n *@ alloc_cost 1
      | Dropn (n, _) ->
          n *@ alloc_cost 1
      | ChainId ->
          alloc_cost 1
  end

  module Unparse = struct
    let prim_cost l annot = Script.prim_node_cost_nonrec_of_length l annot

    let seq_cost = Script.seq_node_cost_nonrec_of_length

    let string_cost length = Script.string_node_cost_of_length length

    let cycle = step_cost 1

    let bool = prim_cost 0 []

    let unit = prim_cost 0 []

    (* We count the length of strings and bytes to prevent hidden
       miscalculations due to non detectable expansion of sharing. *)
    let string s = Script.string_node_cost s

    let bytes s = Script.bytes_node_cost s

    let z i = Script.int_node_cost i

    let int i = Script.int_node_cost (Script_int.to_zint i)

    let tez = Script.int_node_cost_of_numbits 60 (* int64 bound *)

    let timestamp x = Script_timestamp.to_zint x |> Script_int.of_zint |> int

    let operation bytes = Script.bytes_node_cost bytes

    let chain_id bytes = Script.bytes_node_cost bytes

    let key = string_cost 54

    let key_hash = string_cost 36

    let signature = string_cost 128

    let contract = string_cost 36

    let pair = prim_cost 2 []

    let union = prim_cost 1 []

    let some = prim_cost 1 []

    let none = prim_cost 0 []

    let list_element = alloc_cost 2

    let set_element = alloc_cost 2

    let map_element = alloc_cost 2

    let one_arg_type = prim_cost 1

    let two_arg_type = prim_cost 2

    let set_to_list = Legacy.set_to_list

    let map_to_list = Legacy.map_to_list
  end
end

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Import Alpha_context.

Import Gas.

Module Cost_of.
  Definition log2 : Z -> Z :=
    let fix help (acc : Z) (function_parameter : Z) : Z :=
      match function_parameter with
      | 0 => acc
      | n => help (op_plus acc 1) (op_div n 2)
      end in
    help 1.
  
  Definition z_bytes (z : Tezos_protocol_environment_alpha__Environment.Z.t)
    : Z :=
    let bits := Z.numbits z in
    op_div (op_plus 7 bits) 8.
  
  Definition int_bytes {a : Set}
    (z : Tezos_raw_protocol_alpha.Alpha_context.Script_int.num a) : Z :=
    z_bytes (Script_int.to_zint z).
  
  Definition timestamp_bytes
    (t : Tezos_raw_protocol_alpha.Alpha_context.Script_timestamp.t) : Z :=
    let z := Script_timestamp.to_zint t in
    z_bytes z.
  
  Fixpoint size_of_comparable {a b : Set}
    (wit : Tezos_raw_protocol_alpha.Script_typed_ir.comparable_struct a b)
    (v : a) : Z :=
    match wit with
    | Tezos_raw_protocol_alpha.Script_typed_ir.Int_key _ => int_bytes v
    | Tezos_raw_protocol_alpha.Script_typed_ir.Nat_key _ => int_bytes v
    | Tezos_raw_protocol_alpha.Script_typed_ir.String_key _ => String.length v
    | Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_key _ => MBytes.length v
    | Tezos_raw_protocol_alpha.Script_typed_ir.Bool_key _ => 8
    | Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_key _ =>
      Signature.Public_key_hash.size
    | Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_key _ =>
      timestamp_bytes v
    | Tezos_raw_protocol_alpha.Script_typed_ir.Address_key _ =>
      Signature.Public_key_hash.size
    | Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_key _ => 8
    | Tezos_raw_protocol_alpha.Script_typed_ir.Pair_key (l, _) (r, _) _ =>
      let '(lval, rval) := v in
      op_plus (size_of_comparable l lval) (size_of_comparable r rval)
    end.
  
  Definition __string_value (length : Z)
    : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost := alloc_bytes_cost length.
  
  Definition __bytes_value (length : Z)
    : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
    alloc_mbytes_cost length.
  
  Definition manager_operation
    : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost := step_cost 10000.
  
  Module Legacy.
    Definition zint (z : Tezos_protocol_environment_alpha__Environment.Z.t)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      alloc_bits_cost (Z.numbits z).
    
    Definition set_to_list {item : Set}
      (Box : Tezos_raw_protocol_alpha.Script_typed_ir.set item)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      let Box := projT2 Box in
      op_atat alloc_cost
        (op_star Box.(Tezos_raw_protocol_alpha__Script_typed_ir.Boxed_set.size)
          2).
    
    Definition map_to_list {key value : Set}
      (Box : Tezos_raw_protocol_alpha.Script_typed_ir.map key value)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      let Box := projT2 Box in
      let size :=
        snd Box.(Tezos_raw_protocol_alpha__Script_typed_ir.Boxed_map.boxed) in
      op_starat 3 (alloc_cost size).
    
    Definition z_to_int64 : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      op_plusat (step_cost 2) (alloc_cost 1).
    
    Definition __hash_value
      (data : Tezos_protocol_environment_alpha__Environment.MBytes.t) (len : Z)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      op_plusat (op_starat 10 (step_cost (MBytes.length data)))
        (__bytes_value len).
    
    Definition set_access {elt : Set}
      (_key : elt) (Box : Tezos_raw_protocol_alpha.Script_typed_ir.set elt)
      : Z :=
      let Box := projT2 Box in
      op_atat log2
        Box.(Tezos_raw_protocol_alpha__Script_typed_ir.Boxed_set.size).
    
    Definition set_update {A B : Set}
      (key : A) (_presence : B)
      (set : Tezos_raw_protocol_alpha.Script_typed_ir.set A)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      op_starat (set_access key set) (alloc_cost 3).
  End Legacy.
  
  Module Interpreter.
    Definition cycle : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      atomic_step_cost 10.
    
    Definition nop : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost := free.
    
    Definition stack_op : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      atomic_step_cost 10.
    
    Definition push : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      atomic_step_cost 10.
    
    Definition wrap : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      atomic_step_cost 10.
    
    Definition variant_no_data
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost := atomic_step_cost 10.
    
    Definition branch : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      atomic_step_cost 10.
    
    Definition pair : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      atomic_step_cost 10.
    
    Definition pair_access : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      atomic_step_cost 10.
    
    Definition cons : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      atomic_step_cost 10.
    
    Definition loop_size : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      atomic_step_cost 5.
    
    Definition loop_cycle : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      atomic_step_cost 10.
    
    Definition loop_iter : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      atomic_step_cost 20.
    
    Definition loop_map : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      atomic_step_cost 30.
    
    Definition empty_set : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      atomic_step_cost 10.
    
    Definition set_to_list {elt : Set}
      (Box : Tezos_raw_protocol_alpha.Script_typed_ir.set elt)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      let Box := projT2 Box in
      atomic_step_cost
        (op_star Box.(Tezos_raw_protocol_alpha__Script_typed_ir.Boxed_set.size)
          20).
    
    Definition set_mem {elt : Set}
      (elt : elt) (Box : Tezos_raw_protocol_alpha.Script_typed_ir.set elt)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      let Box := projT2 Box in
      let elt_bytes :=
        size_of_comparable
          Box.(Tezos_raw_protocol_alpha__Script_typed_ir.Boxed_set.elt_ty) elt
        in
      atomic_step_cost
        (op_star (op_plus 1 (op_div elt_bytes 82))
          (log2 Box.(Tezos_raw_protocol_alpha__Script_typed_ir.Boxed_set.size))).
    
    Definition set_update {elt : Set} (elt : elt) (function_parameter : bool)
      : Tezos_raw_protocol_alpha.Script_typed_ir.set elt ->
      Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      let '_ := function_parameter in
      fun Box =>
        let Box := projT2 Box in
        let elt_bytes :=
          size_of_comparable
            Box.(Tezos_raw_protocol_alpha__Script_typed_ir.Boxed_set.elt_ty) elt
          in
        atomic_step_cost
          (op_star (op_plus 1 (op_div elt_bytes 82))
            (log2 Box.(Tezos_raw_protocol_alpha__Script_typed_ir.Boxed_set.size))).
    
    Definition set_size : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      atomic_step_cost 10.
    
    Definition empty_map : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      atomic_step_cost 10.
    
    Definition map_to_list {key value : Set}
      (Box : Tezos_raw_protocol_alpha.Script_typed_ir.map key value)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      let Box := projT2 Box in
      let size :=
        snd Box.(Tezos_raw_protocol_alpha__Script_typed_ir.Boxed_map.boxed) in
      atomic_step_cost (op_star size 20).
    
    Definition map_access {key value : Set}
      (key : key) (Box : Tezos_raw_protocol_alpha.Script_typed_ir.map key value)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      let Box := projT2 Box in
      let map_card :=
        snd Box.(Tezos_raw_protocol_alpha__Script_typed_ir.Boxed_map.boxed) in
      let key_bytes :=
        size_of_comparable
          Box.(Tezos_raw_protocol_alpha__Script_typed_ir.Boxed_map.key_ty) key
        in
      atomic_step_cost
        (op_star (op_plus 1 (op_div key_bytes 70)) (log2 map_card)).
    
    Definition map_mem {A B : Set}
      : A -> Tezos_raw_protocol_alpha.Script_typed_ir.map A B ->
      Tezos_raw_protocol_alpha.Alpha_context.Gas.cost := map_access.
    
    Definition map_get {A B : Set}
      : A -> Tezos_raw_protocol_alpha.Script_typed_ir.map A B ->
      Tezos_raw_protocol_alpha.Alpha_context.Gas.cost := map_access.
    
    Definition map_update {key value : Set}
      (key : key) (_value : option value)
      (Box : Tezos_raw_protocol_alpha.Script_typed_ir.map key value)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      let Box := projT2 Box in
      let map_card :=
        snd Box.(Tezos_raw_protocol_alpha__Script_typed_ir.Boxed_map.boxed) in
      let key_bytes :=
        size_of_comparable
          Box.(Tezos_raw_protocol_alpha__Script_typed_ir.Boxed_map.key_ty) key
        in
      atomic_step_cost
        (op_star (op_plus 1 (op_div key_bytes 38)) (log2 map_card)).
    
    Definition map_size : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      atomic_step_cost 10.
    
    Definition add_timestamp {a : Set}
      (t1 : Tezos_raw_protocol_alpha.Alpha_context.Script_timestamp.t)
      (t2 : Tezos_raw_protocol_alpha.Alpha_context.Script_int.num a)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      let bytes1 := timestamp_bytes t1 in
      let bytes2 := int_bytes t2 in
      atomic_step_cost (op_plus 51 (op_div (Compare.Int.max bytes1 bytes2) 62)).
    
    Definition sub_timestamp {A : Set}
      : Tezos_raw_protocol_alpha.Alpha_context.Script_timestamp.t ->
      Tezos_raw_protocol_alpha.Alpha_context.Script_int.num A ->
      Tezos_raw_protocol_alpha.Alpha_context.Gas.cost := add_timestamp.
    
    Definition diff_timestamps
      (t1 : Tezos_raw_protocol_alpha.Alpha_context.Script_timestamp.t)
      (t2 : Tezos_raw_protocol_alpha.Alpha_context.Script_timestamp.t)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      let bytes1 := timestamp_bytes t1 in
      let bytes2 := timestamp_bytes t2 in
      atomic_step_cost (op_plus 51 (op_div (Compare.Int.max bytes1 bytes2) 62)).
    
    Fixpoint concat_loop {A : Set} (l : list A) (acc : Z) : Z :=
      match l with
      | [] => 30
      | cons _ tl => concat_loop tl (op_plus acc 30)
      end.
    
    Definition concat_string {A : Set} (string_list : list A)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      atomic_step_cost (concat_loop string_list 0).
    
    Definition slice_string (string_length : Z)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      atomic_step_cost (op_plus 40 (op_div string_length 70)).
    
    Definition concat_bytes {A : Set} (bytes_list : list A)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      atomic_step_cost (concat_loop bytes_list 0).
    
    Definition int64_op : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      atomic_step_cost 61.
    
    Definition z_to_int64 : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      atomic_step_cost 20.
    
    Definition int64_to_z : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      atomic_step_cost 20.
    
    Definition bool_binop {A B : Set} (function_parameter : A)
      : B -> Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      let '_ := function_parameter in
      fun function_parameter =>
        let '_ := function_parameter in
        atomic_step_cost 10.
    
    Definition bool_unop {A : Set} (function_parameter : A)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      let '_ := function_parameter in
      atomic_step_cost 10.
    
    Definition abs {A : Set}
      (int : Tezos_raw_protocol_alpha.Alpha_context.Script_int.num A)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      atomic_step_cost (op_plus 61 (op_div (int_bytes Z) 70)).
    
    Definition int {A : Set} (_int : A)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost := free.
    
    Definition neg {A : Set}
      : Tezos_raw_protocol_alpha.Alpha_context.Script_int.num A ->
      Tezos_raw_protocol_alpha.Alpha_context.Gas.cost := abs.
    
    Definition add {A B : Set}
      (i1 : Tezos_raw_protocol_alpha.Alpha_context.Script_int.num A)
      (i2 : Tezos_raw_protocol_alpha.Alpha_context.Script_int.num B)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      atomic_step_cost
        (op_plus 51 (op_div (Compare.Int.max (int_bytes i1) (int_bytes i2)) 62)).
    
    Definition sub {A B : Set}
      : Tezos_raw_protocol_alpha.Alpha_context.Script_int.num A ->
      Tezos_raw_protocol_alpha.Alpha_context.Script_int.num B ->
      Tezos_raw_protocol_alpha.Alpha_context.Gas.cost := add.
    
    Definition mul {A B : Set}
      (i1 : Tezos_raw_protocol_alpha.Alpha_context.Script_int.num A)
      (i2 : Tezos_raw_protocol_alpha.Alpha_context.Script_int.num B)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      let __bytes_value := Compare.Int.max (int_bytes i1) (int_bytes i2) in
      atomic_step_cost
        (op_plus 51 (op_star (op_div __bytes_value 6) (log2 __bytes_value))).
    
    Definition indic_lt
      (x : Tezos_protocol_environment_alpha__Environment.Compare.Int.t)
      (y : Tezos_protocol_environment_alpha__Environment.Compare.Int.t) : Z :=
      if op_lt x y then
        1
      else
        0.
    
    Definition div {A B : Set}
      (i1 : Tezos_raw_protocol_alpha.Alpha_context.Script_int.num A)
      (i2 : Tezos_raw_protocol_alpha.Alpha_context.Script_int.num B)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      let bytes1 := int_bytes i1 in
      let bytes2 := int_bytes i2 in
      let cost :=
        op_star (op_star (indic_lt bytes2 bytes1) (op_minus bytes1 bytes2))
          bytes2 in
      atomic_step_cost (op_plus 51 (op_div cost 3151)).
    
    Definition shift_left {A B : Set} (_i : A) (_shift_bits : B)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost := atomic_step_cost 30.
    
    Definition shift_right {A B : Set} (_i : A) (_shift_bits : B)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost := atomic_step_cost 30.
    
    Definition logor {A B : Set}
      (i1 : Tezos_raw_protocol_alpha.Alpha_context.Script_int.num A)
      (i2 : Tezos_raw_protocol_alpha.Alpha_context.Script_int.num B)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      let bytes1 := int_bytes i1 in
      let bytes2 := int_bytes i2 in
      atomic_step_cost (op_plus 51 (op_div (Compare.Int.max bytes1 bytes2) 70)).
    
    Definition logand {A B : Set}
      (i1 : Tezos_raw_protocol_alpha.Alpha_context.Script_int.num A)
      (i2 : Tezos_raw_protocol_alpha.Alpha_context.Script_int.num B)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      let bytes1 := int_bytes i1 in
      let bytes2 := int_bytes i2 in
      atomic_step_cost (op_plus 51 (op_div (Compare.Int.min bytes1 bytes2) 70)).
    
    Definition logxor {A B : Set}
      : Tezos_raw_protocol_alpha.Alpha_context.Script_int.num A ->
      Tezos_raw_protocol_alpha.Alpha_context.Script_int.num B ->
      Tezos_raw_protocol_alpha.Alpha_context.Gas.cost := logor.
    
    Definition lognot {A : Set}
      (i : Tezos_raw_protocol_alpha.Alpha_context.Script_int.num A)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      atomic_step_cost (op_plus 51 (op_div (int_bytes i) 20)).
    
    Definition exec : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      atomic_step_cost 10.
    
    Definition compare_bool {A B : Set} (function_parameter : A)
      : B -> Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      let '_ := function_parameter in
      fun function_parameter =>
        let '_ := function_parameter in
        atomic_step_cost 30.
    
    Definition compare_string (s1 : string) (s2 : string)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      let bytes1 := String.length s1 in
      let bytes2 := String.length s2 in
      atomic_step_cost (op_plus 30 (op_div (Compare.Int.min bytes1 bytes2) 123)).
    
    Definition compare_bytes
      (b1 : Tezos_protocol_environment_alpha__Environment.MBytes.t)
      (b2 : Tezos_protocol_environment_alpha__Environment.MBytes.t)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      let bytes1 := MBytes.length b1 in
      let bytes2 := MBytes.length b2 in
      atomic_step_cost (op_plus 30 (op_div (Compare.Int.min bytes1 bytes2) 123)).
    
    Definition compare_tez {A B : Set} (function_parameter : A)
      : B -> Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      let '_ := function_parameter in
      fun function_parameter =>
        let '_ := function_parameter in
        atomic_step_cost 30.
    
    Definition compare_zint {A B : Set}
      (i1 : Tezos_raw_protocol_alpha.Alpha_context.Script_int.num A)
      (i2 : Tezos_raw_protocol_alpha.Alpha_context.Script_int.num B)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      atomic_step_cost
        (op_plus 51 (op_div (Compare.Int.min (int_bytes i1) (int_bytes i2)) 82)).
    
    Definition compare_key_hash {A B : Set} (function_parameter : A)
      : B -> Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      let '_ := function_parameter in
      fun function_parameter =>
        let '_ := function_parameter in
        atomic_step_cost 92.
    
    Definition compare_timestamp
      (t1 : Tezos_raw_protocol_alpha.Alpha_context.Script_timestamp.t)
      (t2 : Tezos_raw_protocol_alpha.Alpha_context.Script_timestamp.t)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      let bytes1 := timestamp_bytes t1 in
      let bytes2 := timestamp_bytes t2 in
      atomic_step_cost (op_plus 51 (op_div (Compare.Int.min bytes1 bytes2) 82)).
    
    Definition compare_address {A B : Set} (function_parameter : A)
      : B -> Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      let '_ := function_parameter in
      fun function_parameter =>
        let '_ := function_parameter in
        atomic_step_cost 92.
    
    Definition compare_res : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      atomic_step_cost 30.
    
    Definition unpack_failed
      (__bytes_value : Tezos_protocol_environment_alpha__Environment.MBytes.t)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      let len := MBytes.length __bytes_value in
      op_plusat (op_starat len (alloc_mbytes_cost 1))
        (op_starat len
          (op_starat (log2 len) (op_plusat (alloc_cost 3) (step_cost 1)))).
    
    Definition address : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      atomic_step_cost 10.
    
    Definition contract : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      step_cost 10000.
    
    Definition transfer : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      step_cost 10.
    
    Definition create_account
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost := step_cost 10.
    
    Definition create_contract
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost := step_cost 10.
    
    Definition implicit_account
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost := step_cost 10.
    
    Definition set_delegate : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      op_plusat (step_cost 10) (write_bytes_cost (Z.of_int 32)).
    
    Definition balance : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      atomic_step_cost 10.
    
    Definition now : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      atomic_step_cost 10.
    
    Definition check_signature_secp256k1 (__bytes_value : Z)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      atomic_step_cost (op_plus 10342 (op_div __bytes_value 5)).
    
    Definition check_signature_ed25519 (__bytes_value : Z)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      atomic_step_cost (op_plus 36864 (op_div __bytes_value 5)).
    
    Definition check_signature_p256 (__bytes_value : Z)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      atomic_step_cost (op_plus 36864 (op_div __bytes_value 5)).
    
    Definition check_signature
      (pkey : Tezos_protocol_environment_alpha__Environment.Signature.public_key)
      (__bytes_value : Tezos_protocol_environment_alpha__Environment.MBytes.t)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      match pkey with
      | Tezos_protocol_environment_alpha__Environment.Signature.Ed25519 _ =>
        check_signature_ed25519 (MBytes.length __bytes_value)
      | Tezos_protocol_environment_alpha__Environment.Signature.Secp256k1 _ =>
        check_signature_secp256k1 (MBytes.length __bytes_value)
      | Tezos_protocol_environment_alpha__Environment.Signature.P256 _ =>
        check_signature_p256 (MBytes.length __bytes_value)
      end.
    
    Definition hash_key : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      atomic_step_cost 30.
    
    Definition hash_blake2b
      (b : Tezos_protocol_environment_alpha__Environment.MBytes.t)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      atomic_step_cost (op_plus 102 (op_div (MBytes.length b) 5)).
    
    Definition hash_sha256
      (b : Tezos_protocol_environment_alpha__Environment.MBytes.t)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      atomic_step_cost (op_plus 409 (MBytes.length b)).
    
    Definition hash_sha512
      (b : Tezos_protocol_environment_alpha__Environment.MBytes.t)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      let __bytes_value := MBytes.length b in
      atomic_step_cost
        (op_plus 409 (op_plus (lsr __bytes_value 1) (lsr __bytes_value 4))).
    
    Definition steps_to_quota
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost := atomic_step_cost 10.
    
    Definition source : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      atomic_step_cost 10.
    
    Definition self : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      atomic_step_cost 10.
    
    Definition amount : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      atomic_step_cost 10.
    
    Definition chain_id : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      step_cost 1.
    
    Definition stack_n_op (n : Z)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      atomic_step_cost
        (op_plus 20 (op_plus (op_plus (lsr n 1) (lsr n 2)) (lsr n 4))).
    
    Definition apply : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      op_plusat (alloc_cost 8) (step_cost 1).
    
    Fixpoint compare {a s : Set}
      (ty : Tezos_raw_protocol_alpha.Script_typed_ir.comparable_struct a s)
      (x : a) (y : a) : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      match ty with
      | Tezos_raw_protocol_alpha.Script_typed_ir.Bool_key _ => compare_bool x y
      | Tezos_raw_protocol_alpha.Script_typed_ir.String_key _ =>
        compare_string x y
      | Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_key _ =>
        compare_bytes x y
      | Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_key _ => compare_tez x y
      | Tezos_raw_protocol_alpha.Script_typed_ir.Int_key _ => compare_zint x y
      | Tezos_raw_protocol_alpha.Script_typed_ir.Nat_key _ => compare_zint x y
      | Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_key _ =>
        compare_key_hash x y
      | Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_key _ =>
        compare_timestamp x y
      | Tezos_raw_protocol_alpha.Script_typed_ir.Address_key _ =>
        compare_address x y
      | Tezos_raw_protocol_alpha.Script_typed_ir.Pair_key (tl, _) (tr, _) _ =>
        in
        op_plusat (compare tl xl yl) (compare tr xr yr)
      end.
  End Interpreter.
  
  Module Typechecking.
    Definition cycle : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      step_cost 1.
    
    Definition __bool_value : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      free.
    
    Definition __unit_value : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      free.
    
    Definition __string_value
      : Z -> Tezos_raw_protocol_alpha.Alpha_context.Gas.cost := __string_value.
    
    Definition __bytes_value
      : Z -> Tezos_raw_protocol_alpha.Alpha_context.Gas.cost := __bytes_value.
    
    Definition z
      : Tezos_protocol_environment_alpha__Environment.Z.t ->
      Tezos_raw_protocol_alpha.Alpha_context.Gas.cost := Legacy.zint.
    
    Definition int_of_string (str : string)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      op_atat alloc_cost (Pervasives.op_div (String.length str) 5).
    
    Definition tez : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      op_plusat (step_cost 1) (alloc_cost 1).
    
    Definition string_timestamp
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      op_plusat (step_cost 3) (alloc_cost 3).
    
    Definition key : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      op_plusat (step_cost 3) (alloc_cost 3).
    
    Definition key_hash : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      op_plusat (step_cost 1) (alloc_cost 1).
    
    Definition signature : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      op_plusat (step_cost 1) (alloc_cost 1).
    
    Definition chain_id : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      op_plusat (step_cost 1) (alloc_cost 1).
    
    Definition contract : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      step_cost 5.
    
    Definition get_script : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      op_plusat (step_cost 20) (alloc_cost 5).
    
    Definition contract_exists
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      op_plusat (step_cost 15) (alloc_cost 5).
    
    Definition pair : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      alloc_cost 2.
    
    Definition union : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      alloc_cost 1.
    
    Definition lambda : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      op_plusat (alloc_cost 5) (step_cost 3).
    
    Definition some : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      alloc_cost 1.
    
    Definition none : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      alloc_cost 0.
    
    Definition list_element : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      op_plusat (alloc_cost 2) (step_cost 1).
    
    Definition set_element (size : Z)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      op_starat (log2 size) (op_plusat (alloc_cost 3) (step_cost 2)).
    
    Definition map_element (size : Z)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      op_starat (log2 size) (op_plusat (alloc_cost 4) (step_cost 2)).
    
    Definition primitive_type
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost := alloc_cost 1.
    
    Definition one_arg_type : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      alloc_cost 2.
    
    Definition two_arg_type : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      alloc_cost 3.
    
    Definition operation (b : Z)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost := __bytes_value b.
    
    Definition type_ (nb_args : Z)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      alloc_cost (op_plus nb_args 1).
    
    Definition instr {a b : Set}
      (i : Tezos_raw_protocol_alpha.Script_typed_ir.instr b a)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      op_plusat (alloc_cost 1)
        match i with
        | Tezos_raw_protocol_alpha.Script_typed_ir.Drop => alloc_cost 0
        | Tezos_raw_protocol_alpha.Script_typed_ir.Dup => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Swap => alloc_cost 0
        | Tezos_raw_protocol_alpha.Script_typed_ir.Const _ => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Cons_pair => alloc_cost 2
        | Tezos_raw_protocol_alpha.Script_typed_ir.Car => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Cdr => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Cons_some => alloc_cost 2
        | Tezos_raw_protocol_alpha.Script_typed_ir.Cons_none _ => alloc_cost 3
        | Tezos_raw_protocol_alpha.Script_typed_ir.If_none _ _ => alloc_cost 2
        | Tezos_raw_protocol_alpha.Script_typed_ir.Left => alloc_cost 3
        | Tezos_raw_protocol_alpha.Script_typed_ir.Right => alloc_cost 3
        | Tezos_raw_protocol_alpha.Script_typed_ir.If_left _ _ => alloc_cost 2
        | Tezos_raw_protocol_alpha.Script_typed_ir.Cons_list => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Nil => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.If_cons _ _ => alloc_cost 2
        | Tezos_raw_protocol_alpha.Script_typed_ir.List_map _ => alloc_cost 5
        | Tezos_raw_protocol_alpha.Script_typed_ir.List_iter _ => alloc_cost 4
        | Tezos_raw_protocol_alpha.Script_typed_ir.List_size => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Empty_set _ => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Set_iter _ => alloc_cost 4
        | Tezos_raw_protocol_alpha.Script_typed_ir.Set_mem => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Set_update => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Set_size => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Empty_map _ _ => alloc_cost 2
        | Tezos_raw_protocol_alpha.Script_typed_ir.Map_map _ => alloc_cost 5
        | Tezos_raw_protocol_alpha.Script_typed_ir.Map_iter _ => alloc_cost 4
        | Tezos_raw_protocol_alpha.Script_typed_ir.Map_mem => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Map_get => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Map_update => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Map_size => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Empty_big_map _ _ =>
          alloc_cost 2
        | Tezos_raw_protocol_alpha.Script_typed_ir.Big_map_mem => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Big_map_get => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Big_map_update =>
          alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Concat_string => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Concat_string_pair =>
          alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Concat_bytes => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Concat_bytes_pair =>
          alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Slice_string => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Slice_bytes => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.String_size => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_size => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Add_seconds_to_timestamp =>
          alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Add_timestamp_to_seconds =>
          alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Sub_timestamp_seconds =>
          alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Diff_timestamps =>
          alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Add_tez => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Sub_tez => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Mul_teznat => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Mul_nattez => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Ediv_teznat => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Ediv_tez => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Or => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.And => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Xor => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Not => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Is_nat => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Neg_nat => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Neg_int => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Abs_int => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Int_nat => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Add_intint => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Add_intnat => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Add_natint => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Add_natnat => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Sub_int => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Mul_intint => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Mul_intnat => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Mul_natint => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Mul_natnat => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Ediv_intint => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Ediv_intnat => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Ediv_natint => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Ediv_natnat => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Lsl_nat => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Lsr_nat => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Or_nat => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.And_nat => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.And_int_nat => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Xor_nat => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Not_nat => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Not_int => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Seq _ _ => alloc_cost 8
        | Tezos_raw_protocol_alpha.Script_typed_ir.If _ _ => alloc_cost 8
        | Tezos_raw_protocol_alpha.Script_typed_ir.Loop _ => alloc_cost 4
        | Tezos_raw_protocol_alpha.Script_typed_ir.Loop_left _ => alloc_cost 5
        | Tezos_raw_protocol_alpha.Script_typed_ir.Dip _ => alloc_cost 4
        | Tezos_raw_protocol_alpha.Script_typed_ir.Exec => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Apply _ => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Lambda _ => alloc_cost 2
        | Tezos_raw_protocol_alpha.Script_typed_ir.Failwith _ => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Nop => alloc_cost 0
        | Tezos_raw_protocol_alpha.Script_typed_ir.Compare _ => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Eq => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Neq => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Lt => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Gt => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Le => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Ge => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Address => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Contract _ _ => alloc_cost 2
        | Tezos_raw_protocol_alpha.Script_typed_ir.Transfer_tokens =>
          alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Create_account =>
          alloc_cost 2
        | Tezos_raw_protocol_alpha.Script_typed_ir.Implicit_account =>
          alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Create_contract _ _ _ _ =>
          alloc_cost 8
        | Tezos_raw_protocol_alpha.Script_typed_ir.Create_contract_2 _ _ _ _ =>
          alloc_cost 7
        | Tezos_raw_protocol_alpha.Script_typed_ir.Set_delegate => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Now => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Balance => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Check_signature =>
          alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Hash_key => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Pack _ => alloc_cost 2
        | Tezos_raw_protocol_alpha.Script_typed_ir.Unpack _ => alloc_cost 2
        | Tezos_raw_protocol_alpha.Script_typed_ir.Blake2b => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Sha256 => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Sha512 => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Steps_to_quota =>
          alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Source => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Sender => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Self _ _ => alloc_cost 2
        | Tezos_raw_protocol_alpha.Script_typed_ir.Amount => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Dig n _ =>
          op_starat n (alloc_cost 1)
        | Tezos_raw_protocol_alpha.Script_typed_ir.Dug n _ =>
          op_starat n (alloc_cost 1)
        | Tezos_raw_protocol_alpha.Script_typed_ir.Dipn n _ _ =>
          op_starat n (alloc_cost 1)
        | Tezos_raw_protocol_alpha.Script_typed_ir.Dropn n _ =>
          op_starat n (alloc_cost 1)
        | Tezos_raw_protocol_alpha.Script_typed_ir.ChainId => alloc_cost 1
        end.
  End Typechecking.
  
  Module Unparse.
    Definition prim_cost
      (l : Z) (annot : Tezos_raw_protocol_alpha.Alpha_context.Script.annot)
      : Tezos_raw_protocol_alpha__Alpha_context.Gas.cost :=
      Script.prim_node_cost_nonrec_of_length l annot.
    
    Definition seq_cost
      : Z -> Tezos_raw_protocol_alpha__Alpha_context.Gas.cost :=
      Script.seq_node_cost_nonrec_of_length.
    
    Definition string_cost (length : Z)
      : Tezos_raw_protocol_alpha__Alpha_context.Gas.cost :=
      Script.string_node_cost_of_length length.
    
    Definition cycle : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      step_cost 1.
    
    Definition __bool_value
      : Tezos_raw_protocol_alpha__Alpha_context.Gas.cost := prim_cost 0 [].
    
    Definition __unit_value
      : Tezos_raw_protocol_alpha__Alpha_context.Gas.cost := prim_cost 0 [].
    
    Definition __string_value (s : string)
      : Tezos_raw_protocol_alpha__Alpha_context.Gas.cost :=
      Script.string_node_cost s.
    
    Definition __bytes_value
      (s : Tezos_protocol_environment_alpha__Environment.MBytes.t)
      : Tezos_raw_protocol_alpha__Alpha_context.Gas.cost :=
      Script.bytes_node_cost s.
    
    Definition z (i : Tezos_protocol_environment_alpha__Environment.Z.t)
      : Tezos_raw_protocol_alpha__Alpha_context.Gas.cost :=
      Script.int_node_cost i.
    
    Definition int {A : Set}
      (i : Tezos_raw_protocol_alpha.Alpha_context.Script_int.num A)
      : Tezos_raw_protocol_alpha__Alpha_context.Gas.cost :=
      Script.int_node_cost (Script_int.to_zint i).
    
    Definition tez : Tezos_raw_protocol_alpha__Alpha_context.Gas.cost :=
      Script.int_node_cost_of_numbits 60.
    
    Definition timestamp
      (x : Tezos_raw_protocol_alpha.Alpha_context.Script_timestamp.t)
      : Tezos_raw_protocol_alpha__Alpha_context.Gas.cost :=
      op_pipegt (op_pipegt (Script_timestamp.to_zint x) Script_int.of_zint) Z.
    
    Definition operation
      (__bytes_value : Tezos_protocol_environment_alpha__Environment.MBytes.t)
      : Tezos_raw_protocol_alpha__Alpha_context.Gas.cost :=
      Script.bytes_node_cost __bytes_value.
    
    Definition chain_id
      (__bytes_value : Tezos_protocol_environment_alpha__Environment.MBytes.t)
      : Tezos_raw_protocol_alpha__Alpha_context.Gas.cost :=
      Script.bytes_node_cost __bytes_value.
    
    Definition key : Tezos_raw_protocol_alpha__Alpha_context.Gas.cost :=
      string_cost 54.
    
    Definition key_hash : Tezos_raw_protocol_alpha__Alpha_context.Gas.cost :=
      string_cost 36.
    
    Definition signature : Tezos_raw_protocol_alpha__Alpha_context.Gas.cost :=
      string_cost 128.
    
    Definition contract : Tezos_raw_protocol_alpha__Alpha_context.Gas.cost :=
      string_cost 36.
    
    Definition pair : Tezos_raw_protocol_alpha__Alpha_context.Gas.cost :=
      prim_cost 2 [].
    
    Definition union : Tezos_raw_protocol_alpha__Alpha_context.Gas.cost :=
      prim_cost 1 [].
    
    Definition some : Tezos_raw_protocol_alpha__Alpha_context.Gas.cost :=
      prim_cost 1 [].
    
    Definition none : Tezos_raw_protocol_alpha__Alpha_context.Gas.cost :=
      prim_cost 0 [].
    
    Definition list_element : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      alloc_cost 2.
    
    Definition set_element : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      alloc_cost 2.
    
    Definition map_element : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      alloc_cost 2.
    
    Definition one_arg_type
      : Tezos_raw_protocol_alpha.Alpha_context.Script.annot ->
      Tezos_raw_protocol_alpha__Alpha_context.Gas.cost := prim_cost 1.
    
    Definition two_arg_type
      : Tezos_raw_protocol_alpha.Alpha_context.Script.annot ->
      Tezos_raw_protocol_alpha__Alpha_context.Gas.cost := prim_cost 2.
    
    Definition set_to_list {A : Set}
      : Tezos_raw_protocol_alpha.Script_typed_ir.set A ->
      Tezos_raw_protocol_alpha.Alpha_context.Gas.cost := Legacy.set_to_list.
    
    Definition map_to_list {A B : Set}
      : Tezos_raw_protocol_alpha.Script_typed_ir.map A B ->
      Tezos_raw_protocol_alpha.Alpha_context.Gas.cost := Legacy.map_to_list.
  End Unparse.
End Cost_of.

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Alpha_context

module Cost_of : sig
  val manager_operation : Gas.cost

  module Legacy : sig
    val z_to_int64 : Gas.cost

    val hash : MBytes.t -> int -> Gas.cost

    val map_to_list : ('b, 'c) Script_typed_ir.map -> Gas.cost

    val set_update : 'a -> bool -> 'a Script_typed_ir.set -> Gas.cost
  end

  module Interpreter : sig
    val cycle : Gas.cost

    val loop_cycle : Gas.cost

    val loop_size : Gas.cost

    val loop_iter : Gas.cost

    val loop_map : Gas.cost

    val nop : Gas.cost

    val stack_op : Gas.cost

    val stack_n_op : int -> Gas.cost

    val bool_binop : 'a -> 'b -> Gas.cost

    val bool_unop : 'a -> Gas.cost

    val pair : Gas.cost

    val pair_access : Gas.cost

    val cons : Gas.cost

    val variant_no_data : Gas.cost

    val branch : Gas.cost

    val concat_string : string list -> Gas.cost

    val concat_bytes : MBytes.t list -> Gas.cost

    val slice_string : int -> Gas.cost

    val map_mem : 'a -> ('a, 'b) Script_typed_ir.map -> Gas.cost

    val map_to_list : ('a, 'b) Script_typed_ir.map -> Gas.cost

    val map_get : 'a -> ('a, 'b) Script_typed_ir.map -> Gas.cost

    val map_update :
      'a -> 'b option -> ('a, 'b) Script_typed_ir.map -> Gas.cost

    val map_size : Gas.cost

    val set_to_list : 'a Script_typed_ir.set -> Gas.cost

    val set_update : 'a -> bool -> 'a Script_typed_ir.set -> Gas.cost

    val set_mem : 'a -> 'a Script_typed_ir.set -> Gas.cost

    val mul : 'a Script_int.num -> 'b Script_int.num -> Gas.cost

    val div : 'a Script_int.num -> 'b Script_int.num -> Gas.cost

    val add : 'a Script_int.num -> 'b Script_int.num -> Gas.cost

    val sub : 'a Script_int.num -> 'b Script_int.num -> Gas.cost

    val abs : 'a Script_int.num -> Gas.cost

    val neg : 'a Script_int.num -> Gas.cost

    val int : 'a -> Gas.cost

    val add_timestamp : Script_timestamp.t -> 'a Script_int.num -> Gas.cost

    val sub_timestamp : Script_timestamp.t -> 'a Script_int.num -> Gas.cost

    val diff_timestamps : Script_timestamp.t -> Script_timestamp.t -> Gas.cost

    val empty_set : Gas.cost

    val set_size : Gas.cost

    val empty_map : Gas.cost

    val int64_op : Gas.cost

    val z_to_int64 : Gas.cost

    val int64_to_z : Gas.cost

    val logor : 'a Script_int.num -> 'b Script_int.num -> Gas.cost

    val logand : 'a Script_int.num -> 'b Script_int.num -> Gas.cost

    val logxor : 'a Script_int.num -> 'b Script_int.num -> Gas.cost

    val lognot : 'a Script_int.num -> Gas.cost

    val shift_left : 'a Script_int.num -> 'b Script_int.num -> Gas.cost

    val shift_right : 'a Script_int.num -> 'b Script_int.num -> Gas.cost

    val exec : Gas.cost

    val push : Gas.cost

    val compare_res : Gas.cost

    val unpack_failed : MBytes.t -> Gas.cost

    val address : Gas.cost

    val contract : Gas.cost

    val transfer : Gas.cost

    val create_account : Gas.cost

    val create_contract : Gas.cost

    val implicit_account : Gas.cost

    val set_delegate : Gas.cost

    val balance : Gas.cost

    val now : Gas.cost

    val check_signature : public_key -> MBytes.t -> Gas.cost

    val hash_key : Gas.cost

    val hash_blake2b : MBytes.t -> Gas.cost

    val hash_sha256 : MBytes.t -> Gas.cost

    val hash_sha512 : MBytes.t -> Gas.cost

    val steps_to_quota : Gas.cost

    val source : Gas.cost

    val self : Gas.cost

    val amount : Gas.cost

    val chain_id : Gas.cost

    val wrap : Gas.cost

    val compare : 'a Script_typed_ir.comparable_ty -> 'a -> 'a -> Gas.cost

    val apply : Gas.cost
  end

  module Typechecking : sig
    val cycle : Gas.cost

    val unit : Gas.cost

    val bool : Gas.cost

    val tez : Gas.cost

    val z : Z.t -> Gas.cost

    val string : int -> Gas.cost

    val bytes : int -> Gas.cost

    val int_of_string : string -> Gas.cost

    val string_timestamp : Gas.cost

    val key : Gas.cost

    val key_hash : Gas.cost

    val signature : Gas.cost

    val chain_id : Gas.cost

    val contract : Gas.cost

    (** Gas.Cost of getting the code for a contract *)
    val get_script : Gas.cost

    val contract_exists : Gas.cost

    (** Additional Gas.cost of parsing a pair over the Gas.cost of parsing each type  *)
    val pair : Gas.cost

    val union : Gas.cost

    val lambda : Gas.cost

    val some : Gas.cost

    val none : Gas.cost

    val list_element : Gas.cost

    val set_element : int -> Gas.cost

    val map_element : int -> Gas.cost

    val primitive_type : Gas.cost

    val one_arg_type : Gas.cost

    val two_arg_type : Gas.cost

    val operation : int -> Gas.cost

    (** Cost of parsing a type *)
    val type_ : int -> Gas.cost

    (** Cost of parsing an instruction *)
    val instr : ('a, 'b) Script_typed_ir.instr -> Gas.cost
  end

  module Unparse : sig
    val prim_cost : int -> Script.annot -> Gas.cost

    val seq_cost : int -> Gas.cost

    val cycle : Gas.cost

    val unit : Gas.cost

    val bool : Gas.cost

    val z : Z.t -> Gas.cost

    val int : 'a Script_int.num -> Gas.cost

    val tez : Gas.cost

    val string : string -> Gas.cost

    val bytes : MBytes.t -> Gas.cost

    val timestamp : Script_timestamp.t -> Gas.cost

    val key : Gas.cost

    val key_hash : Gas.cost

    val signature : Gas.cost

    val operation : MBytes.t -> Gas.cost

    val chain_id : MBytes.t -> Gas.cost

    val contract : Gas.cost

    (** Additional Gas.cost of parsing a pair over the Gas.cost of parsing each type  *)
    val pair : Gas.cost

    val union : Gas.cost

    val some : Gas.cost

    val none : Gas.cost

    val list_element : Gas.cost

    val set_element : Gas.cost

    val map_element : Gas.cost

    val one_arg_type : Script.annot -> Gas.cost

    val two_arg_type : Script.annot -> Gas.cost

    val set_to_list : 'a Script_typed_ir.set -> Gas.cost

    val map_to_list : ('a, 'b) Script_typed_ir.map -> Gas.cost
  end
end

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Module Cost_of.
  Parameter manager_operation : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
  
  Module Legacy.
    Parameter z_to_int64 : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter __hash_value :
      Tezos_protocol_environment_alpha__Environment.MBytes.t -> Z ->
      Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter map_to_list : forall {b c : Set},
      Tezos_raw_protocol_alpha.Script_typed_ir.map b c ->
      Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter set_update : forall {a : Set},
      a -> bool -> Tezos_raw_protocol_alpha.Script_typed_ir.set a ->
      Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
  End Legacy.
  
  Module Interpreter.
    Parameter cycle : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter loop_cycle : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter loop_size : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter loop_iter : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter loop_map : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter nop : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter stack_op : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter stack_n_op : Z -> Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter bool_binop : forall {a b : Set},
      a -> b -> Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter bool_unop : forall {a : Set},
      a -> Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter pair : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter pair_access : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter cons : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter variant_no_data : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter branch : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter concat_string :
      list string -> Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter concat_bytes :
      list Tezos_protocol_environment_alpha__Environment.MBytes.t ->
      Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter slice_string :
      Z -> Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter map_mem : forall {a b : Set},
      a -> Tezos_raw_protocol_alpha.Script_typed_ir.map a b ->
      Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter map_to_list : forall {a b : Set},
      Tezos_raw_protocol_alpha.Script_typed_ir.map a b ->
      Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter map_get : forall {a b : Set},
      a -> Tezos_raw_protocol_alpha.Script_typed_ir.map a b ->
      Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter map_update : forall {a b : Set},
      a -> option b -> Tezos_raw_protocol_alpha.Script_typed_ir.map a b ->
      Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter map_size : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter set_to_list : forall {a : Set},
      Tezos_raw_protocol_alpha.Script_typed_ir.set a ->
      Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter set_update : forall {a : Set},
      a -> bool -> Tezos_raw_protocol_alpha.Script_typed_ir.set a ->
      Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter set_mem : forall {a : Set},
      a -> Tezos_raw_protocol_alpha.Script_typed_ir.set a ->
      Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter mul : forall {a b : Set},
      Tezos_raw_protocol_alpha.Alpha_context.Script_int.num a ->
      Tezos_raw_protocol_alpha.Alpha_context.Script_int.num b ->
      Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter div : forall {a b : Set},
      Tezos_raw_protocol_alpha.Alpha_context.Script_int.num a ->
      Tezos_raw_protocol_alpha.Alpha_context.Script_int.num b ->
      Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter add : forall {a b : Set},
      Tezos_raw_protocol_alpha.Alpha_context.Script_int.num a ->
      Tezos_raw_protocol_alpha.Alpha_context.Script_int.num b ->
      Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter sub : forall {a b : Set},
      Tezos_raw_protocol_alpha.Alpha_context.Script_int.num a ->
      Tezos_raw_protocol_alpha.Alpha_context.Script_int.num b ->
      Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter abs : forall {a : Set},
      Tezos_raw_protocol_alpha.Alpha_context.Script_int.num a ->
      Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter neg : forall {a : Set},
      Tezos_raw_protocol_alpha.Alpha_context.Script_int.num a ->
      Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter int : forall {a : Set},
      a -> Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter add_timestamp : forall {a : Set},
      Tezos_raw_protocol_alpha.Alpha_context.Script_timestamp.t ->
      Tezos_raw_protocol_alpha.Alpha_context.Script_int.num a ->
      Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter sub_timestamp : forall {a : Set},
      Tezos_raw_protocol_alpha.Alpha_context.Script_timestamp.t ->
      Tezos_raw_protocol_alpha.Alpha_context.Script_int.num a ->
      Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter diff_timestamps :
      Tezos_raw_protocol_alpha.Alpha_context.Script_timestamp.t ->
      Tezos_raw_protocol_alpha.Alpha_context.Script_timestamp.t ->
      Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter empty_set : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter set_size : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter empty_map : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter int64_op : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter z_to_int64 : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter int64_to_z : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter logor : forall {a b : Set},
      Tezos_raw_protocol_alpha.Alpha_context.Script_int.num a ->
      Tezos_raw_protocol_alpha.Alpha_context.Script_int.num b ->
      Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter logand : forall {a b : Set},
      Tezos_raw_protocol_alpha.Alpha_context.Script_int.num a ->
      Tezos_raw_protocol_alpha.Alpha_context.Script_int.num b ->
      Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter logxor : forall {a b : Set},
      Tezos_raw_protocol_alpha.Alpha_context.Script_int.num a ->
      Tezos_raw_protocol_alpha.Alpha_context.Script_int.num b ->
      Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter lognot : forall {a : Set},
      Tezos_raw_protocol_alpha.Alpha_context.Script_int.num a ->
      Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter shift_left : forall {a b : Set},
      Tezos_raw_protocol_alpha.Alpha_context.Script_int.num a ->
      Tezos_raw_protocol_alpha.Alpha_context.Script_int.num b ->
      Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter shift_right : forall {a b : Set},
      Tezos_raw_protocol_alpha.Alpha_context.Script_int.num a ->
      Tezos_raw_protocol_alpha.Alpha_context.Script_int.num b ->
      Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter exec : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter push : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter compare_res : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter unpack_failed :
      Tezos_protocol_environment_alpha__Environment.MBytes.t ->
      Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter address : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter contract : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter transfer : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter create_account : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter create_contract : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter implicit_account :
      Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter set_delegate : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter balance : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter now : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter check_signature :
      Tezos_raw_protocol_alpha.Alpha_context.public_key ->
      Tezos_protocol_environment_alpha__Environment.MBytes.t ->
      Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter hash_key : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter hash_blake2b :
      Tezos_protocol_environment_alpha__Environment.MBytes.t ->
      Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter hash_sha256 :
      Tezos_protocol_environment_alpha__Environment.MBytes.t ->
      Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter hash_sha512 :
      Tezos_protocol_environment_alpha__Environment.MBytes.t ->
      Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter steps_to_quota : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter source : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter self : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter amount : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter chain_id : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter wrap : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter compare : forall {a : Set},
      Tezos_raw_protocol_alpha.Script_typed_ir.comparable_ty a -> a -> a ->
      Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter apply : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
  End Interpreter.
  
  Module Typechecking.
    Parameter cycle : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter __unit_value : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter __bool_value : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter tez : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter z :
      Tezos_protocol_environment_alpha__Environment.Z.t ->
      Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter __string_value :
      Z -> Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter __bytes_value :
      Z -> Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter int_of_string :
      string -> Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter string_timestamp :
      Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter key : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter key_hash : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter signature : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter chain_id : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter contract : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter get_script : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter contract_exists : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter pair : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter union : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter lambda : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter some : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter none : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter list_element : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter set_element :
      Z -> Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter map_element :
      Z -> Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter primitive_type : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter one_arg_type : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter two_arg_type : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter operation : Z -> Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter type_ : Z -> Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter instr : forall {a b : Set},
      Tezos_raw_protocol_alpha.Script_typed_ir.instr a b ->
      Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
  End Typechecking.
  
  Module Unparse.
    Parameter prim_cost :
      Z -> Tezos_raw_protocol_alpha.Alpha_context.Script.annot ->
      Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter seq_cost : Z -> Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter cycle : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter __unit_value : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter __bool_value : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter z :
      Tezos_protocol_environment_alpha__Environment.Z.t ->
      Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter int : forall {a : Set},
      Tezos_raw_protocol_alpha.Alpha_context.Script_int.num a ->
      Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter tez : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter __string_value :
      string -> Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter __bytes_value :
      Tezos_protocol_environment_alpha__Environment.MBytes.t ->
      Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter timestamp :
      Tezos_raw_protocol_alpha.Alpha_context.Script_timestamp.t ->
      Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter key : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter key_hash : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter signature : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter operation :
      Tezos_protocol_environment_alpha__Environment.MBytes.t ->
      Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter chain_id :
      Tezos_protocol_environment_alpha__Environment.MBytes.t ->
      Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter contract : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter pair : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter union : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter some : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter none : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter list_element : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter set_element : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter map_element : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter one_arg_type :
      Tezos_raw_protocol_alpha.Alpha_context.Script.annot ->
      Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter two_arg_type :
      Tezos_raw_protocol_alpha.Alpha_context.Script.annot ->
      Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter set_to_list : forall {a : Set},
      Tezos_raw_protocol_alpha.Script_typed_ir.set a ->
      Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter map_to_list : forall {a b : Set},
      Tezos_raw_protocol_alpha.Script_typed_ir.map a b ->
      Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
  End Unparse.
End Cost_of.

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Micheline

type error += Unknown_primitive_name of string

type error += Invalid_case of string

type error +=
  | Invalid_primitive_name of
      string Micheline.canonical * Micheline.canonical_location

type prim =
  | K_parameter
  | K_storage
  | K_code
  | D_False
  | D_Elt
  | D_Left
  | D_None
  | D_Pair
  | D_Right
  | D_Some
  | D_True
  | D_Unit
  | I_PACK
  | I_UNPACK
  | I_BLAKE2B
  | I_SHA256
  | I_SHA512
  | I_ABS
  | I_ADD
  | I_AMOUNT
  | I_AND
  | I_BALANCE
  | I_CAR
  | I_CDR
  | I_CHAIN_ID
  | I_CHECK_SIGNATURE
  | I_COMPARE
  | I_CONCAT
  | I_CONS
  | I_CREATE_ACCOUNT
  | I_CREATE_CONTRACT
  | I_IMPLICIT_ACCOUNT
  | I_DIP
  | I_DROP
  | I_DUP
  | I_EDIV
  | I_EMPTY_BIG_MAP
  | I_EMPTY_MAP
  | I_EMPTY_SET
  | I_EQ
  | I_EXEC
  | I_APPLY
  | I_FAILWITH
  | I_GE
  | I_GET
  | I_GT
  | I_HASH_KEY
  | I_IF
  | I_IF_CONS
  | I_IF_LEFT
  | I_IF_NONE
  | I_INT
  | I_LAMBDA
  | I_LE
  | I_LEFT
  | I_LOOP
  | I_LSL
  | I_LSR
  | I_LT
  | I_MAP
  | I_MEM
  | I_MUL
  | I_NEG
  | I_NEQ
  | I_NIL
  | I_NONE
  | I_NOT
  | I_NOW
  | I_OR
  | I_PAIR
  | I_PUSH
  | I_RIGHT
  | I_SIZE
  | I_SOME
  | I_SOURCE
  | I_SENDER
  | I_SELF
  | I_SLICE
  | I_STEPS_TO_QUOTA
  | I_SUB
  | I_SWAP
  | I_TRANSFER_TOKENS
  | I_SET_DELEGATE
  | I_UNIT
  | I_UPDATE
  | I_XOR
  | I_ITER
  | I_LOOP_LEFT
  | I_ADDRESS
  | I_CONTRACT
  | I_ISNAT
  | I_CAST
  | I_RENAME
  | I_DIG
  | I_DUG
  | T_bool
  | T_contract
  | T_int
  | T_key
  | T_key_hash
  | T_lambda
  | T_list
  | T_map
  | T_big_map
  | T_nat
  | T_option
  | T_or
  | T_pair
  | T_set
  | T_signature
  | T_string
  | T_bytes
  | T_mutez
  | T_timestamp
  | T_unit
  | T_operation
  | T_address
  | T_chain_id

let valid_case name =
  let is_lower = function '_' | 'a' .. 'z' -> true | _ -> false in
  let is_upper = function '_' | 'A' .. 'Z' -> true | _ -> false in
  let rec for_all a b f =
    Compare.Int.(a > b) || (f a && for_all (a + 1) b f)
  in
  let len = String.length name in
  Compare.Int.(len <> 0)
  && Compare.Char.(name.[0] <> '_')
  && ( (is_upper name.[0] && for_all 1 (len - 1) (fun i -> is_upper name.[i]))
     || (is_upper name.[0] && for_all 1 (len - 1) (fun i -> is_lower name.[i]))
     || (is_lower name.[0] && for_all 1 (len - 1) (fun i -> is_lower name.[i]))
     )

let string_of_prim = function
  | K_parameter ->
      "parameter"
  | K_storage ->
      "storage"
  | K_code ->
      "code"
  | D_False ->
      "False"
  | D_Elt ->
      "Elt"
  | D_Left ->
      "Left"
  | D_None ->
      "None"
  | D_Pair ->
      "Pair"
  | D_Right ->
      "Right"
  | D_Some ->
      "Some"
  | D_True ->
      "True"
  | D_Unit ->
      "Unit"
  | I_PACK ->
      "PACK"
  | I_UNPACK ->
      "UNPACK"
  | I_BLAKE2B ->
      "BLAKE2B"
  | I_SHA256 ->
      "SHA256"
  | I_SHA512 ->
      "SHA512"
  | I_ABS ->
      "ABS"
  | I_ADD ->
      "ADD"
  | I_AMOUNT ->
      "AMOUNT"
  | I_AND ->
      "AND"
  | I_BALANCE ->
      "BALANCE"
  | I_CAR ->
      "CAR"
  | I_CDR ->
      "CDR"
  | I_CHAIN_ID ->
      "CHAIN_ID"
  | I_CHECK_SIGNATURE ->
      "CHECK_SIGNATURE"
  | I_COMPARE ->
      "COMPARE"
  | I_CONCAT ->
      "CONCAT"
  | I_CONS ->
      "CONS"
  | I_CREATE_ACCOUNT ->
      "CREATE_ACCOUNT"
  | I_CREATE_CONTRACT ->
      "CREATE_CONTRACT"
  | I_IMPLICIT_ACCOUNT ->
      "IMPLICIT_ACCOUNT"
  | I_DIP ->
      "DIP"
  | I_DROP ->
      "DROP"
  | I_DUP ->
      "DUP"
  | I_EDIV ->
      "EDIV"
  | I_EMPTY_BIG_MAP ->
      "EMPTY_BIG_MAP"
  | I_EMPTY_MAP ->
      "EMPTY_MAP"
  | I_EMPTY_SET ->
      "EMPTY_SET"
  | I_EQ ->
      "EQ"
  | I_EXEC ->
      "EXEC"
  | I_APPLY ->
      "APPLY"
  | I_FAILWITH ->
      "FAILWITH"
  | I_GE ->
      "GE"
  | I_GET ->
      "GET"
  | I_GT ->
      "GT"
  | I_HASH_KEY ->
      "HASH_KEY"
  | I_IF ->
      "IF"
  | I_IF_CONS ->
      "IF_CONS"
  | I_IF_LEFT ->
      "IF_LEFT"
  | I_IF_NONE ->
      "IF_NONE"
  | I_INT ->
      "INT"
  | I_LAMBDA ->
      "LAMBDA"
  | I_LE ->
      "LE"
  | I_LEFT ->
      "LEFT"
  | I_LOOP ->
      "LOOP"
  | I_LSL ->
      "LSL"
  | I_LSR ->
      "LSR"
  | I_LT ->
      "LT"
  | I_MAP ->
      "MAP"
  | I_MEM ->
      "MEM"
  | I_MUL ->
      "MUL"
  | I_NEG ->
      "NEG"
  | I_NEQ ->
      "NEQ"
  | I_NIL ->
      "NIL"
  | I_NONE ->
      "NONE"
  | I_NOT ->
      "NOT"
  | I_NOW ->
      "NOW"
  | I_OR ->
      "OR"
  | I_PAIR ->
      "PAIR"
  | I_PUSH ->
      "PUSH"
  | I_RIGHT ->
      "RIGHT"
  | I_SIZE ->
      "SIZE"
  | I_SOME ->
      "SOME"
  | I_SOURCE ->
      "SOURCE"
  | I_SENDER ->
      "SENDER"
  | I_SELF ->
      "SELF"
  | I_SLICE ->
      "SLICE"
  | I_STEPS_TO_QUOTA ->
      "STEPS_TO_QUOTA"
  | I_SUB ->
      "SUB"
  | I_SWAP ->
      "SWAP"
  | I_TRANSFER_TOKENS ->
      "TRANSFER_TOKENS"
  | I_SET_DELEGATE ->
      "SET_DELEGATE"
  | I_UNIT ->
      "UNIT"
  | I_UPDATE ->
      "UPDATE"
  | I_XOR ->
      "XOR"
  | I_ITER ->
      "ITER"
  | I_LOOP_LEFT ->
      "LOOP_LEFT"
  | I_ADDRESS ->
      "ADDRESS"
  | I_CONTRACT ->
      "CONTRACT"
  | I_ISNAT ->
      "ISNAT"
  | I_CAST ->
      "CAST"
  | I_RENAME ->
      "RENAME"
  | I_DIG ->
      "DIG"
  | I_DUG ->
      "DUG"
  | T_bool ->
      "bool"
  | T_contract ->
      "contract"
  | T_int ->
      "int"
  | T_key ->
      "key"
  | T_key_hash ->
      "key_hash"
  | T_lambda ->
      "lambda"
  | T_list ->
      "list"
  | T_map ->
      "map"
  | T_big_map ->
      "big_map"
  | T_nat ->
      "nat"
  | T_option ->
      "option"
  | T_or ->
      "or"
  | T_pair ->
      "pair"
  | T_set ->
      "set"
  | T_signature ->
      "signature"
  | T_string ->
      "string"
  | T_bytes ->
      "bytes"
  | T_mutez ->
      "mutez"
  | T_timestamp ->
      "timestamp"
  | T_unit ->
      "unit"
  | T_operation ->
      "operation"
  | T_address ->
      "address"
  | T_chain_id ->
      "chain_id"

let prim_of_string = function
  | "parameter" ->
      ok K_parameter
  | "storage" ->
      ok K_storage
  | "code" ->
      ok K_code
  | "False" ->
      ok D_False
  | "Elt" ->
      ok D_Elt
  | "Left" ->
      ok D_Left
  | "None" ->
      ok D_None
  | "Pair" ->
      ok D_Pair
  | "Right" ->
      ok D_Right
  | "Some" ->
      ok D_Some
  | "True" ->
      ok D_True
  | "Unit" ->
      ok D_Unit
  | "PACK" ->
      ok I_PACK
  | "UNPACK" ->
      ok I_UNPACK
  | "BLAKE2B" ->
      ok I_BLAKE2B
  | "SHA256" ->
      ok I_SHA256
  | "SHA512" ->
      ok I_SHA512
  | "ABS" ->
      ok I_ABS
  | "ADD" ->
      ok I_ADD
  | "AMOUNT" ->
      ok I_AMOUNT
  | "AND" ->
      ok I_AND
  | "BALANCE" ->
      ok I_BALANCE
  | "CAR" ->
      ok I_CAR
  | "CDR" ->
      ok I_CDR
  | "CHAIN_ID" ->
      ok I_CHAIN_ID
  | "CHECK_SIGNATURE" ->
      ok I_CHECK_SIGNATURE
  | "COMPARE" ->
      ok I_COMPARE
  | "CONCAT" ->
      ok I_CONCAT
  | "CONS" ->
      ok I_CONS
  | "CREATE_ACCOUNT" ->
      ok I_CREATE_ACCOUNT
  | "CREATE_CONTRACT" ->
      ok I_CREATE_CONTRACT
  | "IMPLICIT_ACCOUNT" ->
      ok I_IMPLICIT_ACCOUNT
  | "DIP" ->
      ok I_DIP
  | "DROP" ->
      ok I_DROP
  | "DUP" ->
      ok I_DUP
  | "EDIV" ->
      ok I_EDIV
  | "EMPTY_BIG_MAP" ->
      ok I_EMPTY_BIG_MAP
  | "EMPTY_MAP" ->
      ok I_EMPTY_MAP
  | "EMPTY_SET" ->
      ok I_EMPTY_SET
  | "EQ" ->
      ok I_EQ
  | "EXEC" ->
      ok I_EXEC
  | "APPLY" ->
      ok I_APPLY
  | "FAILWITH" ->
      ok I_FAILWITH
  | "GE" ->
      ok I_GE
  | "GET" ->
      ok I_GET
  | "GT" ->
      ok I_GT
  | "HASH_KEY" ->
      ok I_HASH_KEY
  | "IF" ->
      ok I_IF
  | "IF_CONS" ->
      ok I_IF_CONS
  | "IF_LEFT" ->
      ok I_IF_LEFT
  | "IF_NONE" ->
      ok I_IF_NONE
  | "INT" ->
      ok I_INT
  | "LAMBDA" ->
      ok I_LAMBDA
  | "LE" ->
      ok I_LE
  | "LEFT" ->
      ok I_LEFT
  | "LOOP" ->
      ok I_LOOP
  | "LSL" ->
      ok I_LSL
  | "LSR" ->
      ok I_LSR
  | "LT" ->
      ok I_LT
  | "MAP" ->
      ok I_MAP
  | "MEM" ->
      ok I_MEM
  | "MUL" ->
      ok I_MUL
  | "NEG" ->
      ok I_NEG
  | "NEQ" ->
      ok I_NEQ
  | "NIL" ->
      ok I_NIL
  | "NONE" ->
      ok I_NONE
  | "NOT" ->
      ok I_NOT
  | "NOW" ->
      ok I_NOW
  | "OR" ->
      ok I_OR
  | "PAIR" ->
      ok I_PAIR
  | "PUSH" ->
      ok I_PUSH
  | "RIGHT" ->
      ok I_RIGHT
  | "SIZE" ->
      ok I_SIZE
  | "SOME" ->
      ok I_SOME
  | "SOURCE" ->
      ok I_SOURCE
  | "SENDER" ->
      ok I_SENDER
  | "SELF" ->
      ok I_SELF
  | "SLICE" ->
      ok I_SLICE
  | "STEPS_TO_QUOTA" ->
      ok I_STEPS_TO_QUOTA
  | "SUB" ->
      ok I_SUB
  | "SWAP" ->
      ok I_SWAP
  | "TRANSFER_TOKENS" ->
      ok I_TRANSFER_TOKENS
  | "SET_DELEGATE" ->
      ok I_SET_DELEGATE
  | "UNIT" ->
      ok I_UNIT
  | "UPDATE" ->
      ok I_UPDATE
  | "XOR" ->
      ok I_XOR
  | "ITER" ->
      ok I_ITER
  | "LOOP_LEFT" ->
      ok I_LOOP_LEFT
  | "ADDRESS" ->
      ok I_ADDRESS
  | "CONTRACT" ->
      ok I_CONTRACT
  | "ISNAT" ->
      ok I_ISNAT
  | "CAST" ->
      ok I_CAST
  | "RENAME" ->
      ok I_RENAME
  | "DIG" ->
      ok I_DIG
  | "DUG" ->
      ok I_DUG
  | "bool" ->
      ok T_bool
  | "contract" ->
      ok T_contract
  | "int" ->
      ok T_int
  | "key" ->
      ok T_key
  | "key_hash" ->
      ok T_key_hash
  | "lambda" ->
      ok T_lambda
  | "list" ->
      ok T_list
  | "map" ->
      ok T_map
  | "big_map" ->
      ok T_big_map
  | "nat" ->
      ok T_nat
  | "option" ->
      ok T_option
  | "or" ->
      ok T_or
  | "pair" ->
      ok T_pair
  | "set" ->
      ok T_set
  | "signature" ->
      ok T_signature
  | "string" ->
      ok T_string
  | "bytes" ->
      ok T_bytes
  | "mutez" ->
      ok T_mutez
  | "timestamp" ->
      ok T_timestamp
  | "unit" ->
      ok T_unit
  | "operation" ->
      ok T_operation
  | "address" ->
      ok T_address
  | "chain_id" ->
      ok T_chain_id
  | n ->
      if valid_case n then error (Unknown_primitive_name n)
      else error (Invalid_case n)

let prims_of_strings expr =
  let rec convert = function
    | (Int _ | String _ | Bytes _) as expr ->
        ok expr
    | Prim (loc, prim, args, annot) ->
        Error_monad.record_trace
          (Invalid_primitive_name (expr, loc))
          (prim_of_string prim)
        >>? fun prim ->
        List.fold_left
          (fun acc arg ->
            acc >>? fun args -> convert arg >>? fun arg -> ok (arg :: args))
          (ok [])
          args
        >>? fun args -> ok (Prim (0, prim, List.rev args, annot))
    | Seq (_, args) ->
        List.fold_left
          (fun acc arg ->
            acc >>? fun args -> convert arg >>? fun arg -> ok (arg :: args))
          (ok [])
          args
        >>? fun args -> ok (Seq (0, List.rev args))
  in
  convert (root expr) >>? fun expr -> ok (strip_locations expr)

let strings_of_prims expr =
  let rec convert = function
    | (Int _ | String _ | Bytes _) as expr ->
        expr
    | Prim (_, prim, args, annot) ->
        let prim = string_of_prim prim in
        let args = List.map convert args in
        Prim (0, prim, args, annot)
    | Seq (_, args) ->
        let args = List.map convert args in
        Seq (0, args)
  in
  strip_locations (convert (root expr))

let prim_encoding =
  let open Data_encoding in
  def "michelson.v1.primitives"
  @@ string_enum
       [ (* /!\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)
         ("parameter", K_parameter);
         ("storage", K_storage);
         ("code", K_code);
         ("False", D_False);
         ("Elt", D_Elt);
         ("Left", D_Left);
         ("None", D_None);
         ("Pair", D_Pair);
         ("Right", D_Right);
         ("Some", D_Some);
         (* /!\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)
         ("True", D_True);
         ("Unit", D_Unit);
         ("PACK", I_PACK);
         ("UNPACK", I_UNPACK);
         ("BLAKE2B", I_BLAKE2B);
         ("SHA256", I_SHA256);
         ("SHA512", I_SHA512);
         ("ABS", I_ABS);
         ("ADD", I_ADD);
         ("AMOUNT", I_AMOUNT);
         (* /!\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)
         ("AND", I_AND);
         ("BALANCE", I_BALANCE);
         ("CAR", I_CAR);
         ("CDR", I_CDR);
         ("CHECK_SIGNATURE", I_CHECK_SIGNATURE);
         ("COMPARE", I_COMPARE);
         ("CONCAT", I_CONCAT);
         ("CONS", I_CONS);
         ("CREATE_ACCOUNT", I_CREATE_ACCOUNT);
         ("CREATE_CONTRACT", I_CREATE_CONTRACT);
         (* /!\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)
         ("IMPLICIT_ACCOUNT", I_IMPLICIT_ACCOUNT);
         ("DIP", I_DIP);
         ("DROP", I_DROP);
         ("DUP", I_DUP);
         ("EDIV", I_EDIV);
         ("EMPTY_MAP", I_EMPTY_MAP);
         ("EMPTY_SET", I_EMPTY_SET);
         ("EQ", I_EQ);
         ("EXEC", I_EXEC);
         ("FAILWITH", I_FAILWITH);
         (* /!\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)
         ("GE", I_GE);
         ("GET", I_GET);
         ("GT", I_GT);
         ("HASH_KEY", I_HASH_KEY);
         ("IF", I_IF);
         ("IF_CONS", I_IF_CONS);
         ("IF_LEFT", I_IF_LEFT);
         ("IF_NONE", I_IF_NONE);
         ("INT", I_INT);
         ("LAMBDA", I_LAMBDA);
         (* /!\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)
         ("LE", I_LE);
         ("LEFT", I_LEFT);
         ("LOOP", I_LOOP);
         ("LSL", I_LSL);
         ("LSR", I_LSR);
         ("LT", I_LT);
         ("MAP", I_MAP);
         ("MEM", I_MEM);
         ("MUL", I_MUL);
         ("NEG", I_NEG);
         (* /!\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)
         ("NEQ", I_NEQ);
         ("NIL", I_NIL);
         ("NONE", I_NONE);
         ("NOT", I_NOT);
         ("NOW", I_NOW);
         ("OR", I_OR);
         ("PAIR", I_PAIR);
         ("PUSH", I_PUSH);
         ("RIGHT", I_RIGHT);
         ("SIZE", I_SIZE);
         (* /!\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)
         ("SOME", I_SOME);
         ("SOURCE", I_SOURCE);
         ("SENDER", I_SENDER);
         ("SELF", I_SELF);
         ("STEPS_TO_QUOTA", I_STEPS_TO_QUOTA);
         ("SUB", I_SUB);
         ("SWAP", I_SWAP);
         ("TRANSFER_TOKENS", I_TRANSFER_TOKENS);
         ("SET_DELEGATE", I_SET_DELEGATE);
         ("UNIT", I_UNIT);
         (* /!\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)
         ("UPDATE", I_UPDATE);
         ("XOR", I_XOR);
         ("ITER", I_ITER);
         ("LOOP_LEFT", I_LOOP_LEFT);
         ("ADDRESS", I_ADDRESS);
         ("CONTRACT", I_CONTRACT);
         ("ISNAT", I_ISNAT);
         ("CAST", I_CAST);
         ("RENAME", I_RENAME);
         ("bool", T_bool);
         (* /!\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)
         ("contract", T_contract);
         ("int", T_int);
         ("key", T_key);
         ("key_hash", T_key_hash);
         ("lambda", T_lambda);
         ("list", T_list);
         ("map", T_map);
         ("big_map", T_big_map);
         ("nat", T_nat);
         ("option", T_option);
         (* /!\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)
         ("or", T_or);
         ("pair", T_pair);
         ("set", T_set);
         ("signature", T_signature);
         ("string", T_string);
         ("bytes", T_bytes);
         ("mutez", T_mutez);
         ("timestamp", T_timestamp);
         ("unit", T_unit);
         ("operation", T_operation);
         (* /!\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)
         ("address", T_address);
         (* Alpha_002 addition *)
         ("SLICE", I_SLICE);
         (* Alpha_005 addition *)
         ("DIG", I_DIG);
         ("DUG", I_DUG);
         ("EMPTY_BIG_MAP", I_EMPTY_BIG_MAP);
         ("APPLY", I_APPLY);
         ("chain_id", T_chain_id);
         ("CHAIN_ID", I_CHAIN_ID)
         (* New instructions must be added here, for backward compatibility of the encoding. *)
        ]

let () =
  register_error_kind
    `Permanent
    ~id:"michelson_v1.unknown_primitive_name"
    ~title:"Unknown primitive name"
    ~description:"In a script or data expression, a primitive was unknown."
    ~pp:(fun ppf n -> Format.fprintf ppf "Unknown primitive %s." n)
    Data_encoding.(obj1 (req "wrong_primitive_name" string))
    (function Unknown_primitive_name got -> Some got | _ -> None)
    (fun got -> Unknown_primitive_name got) ;
  register_error_kind
    `Permanent
    ~id:"michelson_v1.invalid_primitive_name_case"
    ~title:"Invalid primitive name case"
    ~description:
      "In a script or data expression, a primitive name is neither uppercase, \
       lowercase or capitalized."
    ~pp:(fun ppf n -> Format.fprintf ppf "Primitive %s has invalid case." n)
    Data_encoding.(obj1 (req "wrong_primitive_name" string))
    (function Invalid_case name -> Some name | _ -> None)
    (fun name -> Invalid_case name) ;
  register_error_kind
    `Permanent
    ~id:"michelson_v1.invalid_primitive_name"
    ~title:"Invalid primitive name"
    ~description:
      "In a script or data expression, a primitive name is unknown or has a \
       wrong case."
    ~pp:(fun ppf _ -> Format.fprintf ppf "Invalid primitive.")
    Data_encoding.(
      obj2
        (req
           "expression"
           (Micheline.canonical_encoding ~variant:"generic" string))
        (req "location" Micheline.canonical_location_encoding))
    (function
      | Invalid_primitive_name (expr, loc) -> Some (expr, loc) | _ -> None)
    (fun (expr, loc) -> Invalid_primitive_name (expr, loc))

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Import Micheline.

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

Inductive prim : Set :=
| K_parameter : prim
| K_storage : prim
| K_code : prim
| D_False : prim
| D_Elt : prim
| D_Left : prim
| D_None : prim
| D_Pair : prim
| D_Right : prim
| D_Some : prim
| D_True : prim
| D_Unit : prim
| I_PACK : prim
| I_UNPACK : prim
| I_BLAKE2B : prim
| I_SHA256 : prim
| I_SHA512 : prim
| I_ABS : prim
| I_ADD : prim
| I_AMOUNT : prim
| I_AND : prim
| I_BALANCE : prim
| I_CAR : prim
| I_CDR : prim
| I_CHAIN_ID : prim
| I_CHECK_SIGNATURE : prim
| I_COMPARE : prim
| I_CONCAT : prim
| I_CONS : prim
| I_CREATE_ACCOUNT : prim
| I_CREATE_CONTRACT : prim
| I_IMPLICIT_ACCOUNT : prim
| I_DIP : prim
| I_DROP : prim
| I_DUP : prim
| I_EDIV : prim
| I_EMPTY_BIG_MAP : prim
| I_EMPTY_MAP : prim
| I_EMPTY_SET : prim
| I_EQ : prim
| I_EXEC : prim
| I_APPLY : prim
| I_FAILWITH : prim
| I_GE : prim
| I_GET : prim
| I_GT : prim
| I_HASH_KEY : prim
| I_IF : prim
| I_IF_CONS : prim
| I_IF_LEFT : prim
| I_IF_NONE : prim
| I_INT : prim
| I_LAMBDA : prim
| I_LE : prim
| I_LEFT : prim
| I_LOOP : prim
| I_LSL : prim
| I_LSR : prim
| I_LT : prim
| I_MAP : prim
| I_MEM : prim
| I_MUL : prim
| I_NEG : prim
| I_NEQ : prim
| I_NIL : prim
| I_NONE : prim
| I_NOT : prim
| I_NOW : prim
| I_OR : prim
| I_PAIR : prim
| I_PUSH : prim
| I_RIGHT : prim
| I_SIZE : prim
| I_SOME : prim
| I_SOURCE : prim
| I_SENDER : prim
| I_SELF : prim
| I_SLICE : prim
| I_STEPS_TO_QUOTA : prim
| I_SUB : prim
| I_SWAP : prim
| I_TRANSFER_TOKENS : prim
| I_SET_DELEGATE : prim
| I_UNIT : prim
| I_UPDATE : prim
| I_XOR : prim
| I_ITER : prim
| I_LOOP_LEFT : prim
| I_ADDRESS : prim
| I_CONTRACT : prim
| I_ISNAT : prim
| I_CAST : prim
| I_RENAME : prim
| I_DIG : prim
| I_DUG : prim
| T_bool : prim
| T_contract : prim
| T_int : prim
| T_key : prim
| T_key_hash : prim
| T_lambda : prim
| T_list : prim
| T_map : prim
| T_big_map : prim
| T_nat : prim
| T_option : prim
| T_or : prim
| T_pair : prim
| T_set : prim
| T_signature : prim
| T_string : prim
| T_bytes : prim
| T_mutez : prim
| T_timestamp : prim
| T_unit : prim
| T_operation : prim
| T_address : prim
| T_chain_id : prim.

Definition valid_case (name : string) : bool :=
  let is_lower (function_parameter : ascii) : bool :=
    match function_parameter with
    |
      "_" % char |
        "a" % char |
          "b" % char |
            "c" % char |
              "d" % char |
                "e" % char |
                  "f" % char |
                    "g" % char |
                      "h" % char |
                        "i" % char |
                          "j" % char |
                            "k" % char |
                              "l" % char |
                                "m" % char |
                                  "n" % char |
                                    "o" % char |
                                      "p" % char |
                                        "q" % char |
                                          "r" % char |
                                            "s" % char |
                                              "t" % char |
                                                "u" % char |
                                                  "v" % char |
                                                    "w" % char |
                                                      "x" % char |
                                                        "y" % char | "z" % char
      => true
    | _ => false
    end in
  let is_upper (function_parameter : ascii) : bool :=
    match function_parameter with
    |
      "_" % char |
        "A" % char |
          "B" % char |
            "C" % char |
              "D" % char |
                "E" % char |
                  "F" % char |
                    "G" % char |
                      "H" % char |
                        "I" % char |
                          "J" % char |
                            "K" % char |
                              "L" % char |
                                "M" % char |
                                  "N" % char |
                                    "O" % char |
                                      "P" % char |
                                        "Q" % char |
                                          "R" % char |
                                            "S" % char |
                                              "T" % char |
                                                "U" % char |
                                                  "V" % char |
                                                    "W" % char |
                                                      "X" % char |
                                                        "Y" % char | "Z" % char
      => true
    | _ => false
    end in
  let fix for_all
    (a : Tezos_protocol_environment_alpha__Environment.Compare.Int.t) (b :
    Tezos_protocol_environment_alpha__Environment.Compare.Int.t) (f :
    Tezos_protocol_environment_alpha__Environment.Compare.Int.t -> bool)
    : bool :=
    op_pipepipe (op_gt a b) (op_andand (f a) (for_all (op_plus a 1) b f)) in
  let len := String.length name in
  op_andand (op_ltgt len 0)
    (op_andand (op_ltgt (String.get name 0) "_" % char)
      (op_pipepipe
        (op_andand (is_upper (String.get name 0))
          (for_all 1 (op_minus len 1) (fun i => is_upper (String.get name i))))
        (op_pipepipe
          (op_andand (is_upper (String.get name 0))
            (for_all 1 (op_minus len 1) (fun i => is_lower (String.get name i))))
          (op_andand (is_lower (String.get name 0))
            (for_all 1 (op_minus len 1) (fun i => is_lower (String.get name i))))))).

Definition string_of_prim (function_parameter : prim) : string :=
  match function_parameter with
  | K_parameter => "parameter" % string
  | K_storage => "storage" % string
  | K_code => "code" % string
  | D_False => "False" % string
  | D_Elt => "Elt" % string
  | D_Left => "Left" % string
  | D_None => "None" % string
  | D_Pair => "Pair" % string
  | D_Right => "Right" % string
  | D_Some => "Some" % string
  | D_True => "True" % string
  | D_Unit => "Unit" % string
  | I_PACK => "PACK" % string
  | I_UNPACK => "UNPACK" % string
  | I_BLAKE2B => "BLAKE2B" % string
  | I_SHA256 => "SHA256" % string
  | I_SHA512 => "SHA512" % string
  | I_ABS => "ABS" % string
  | I_ADD => "ADD" % string
  | I_AMOUNT => "AMOUNT" % string
  | I_AND => "AND" % string
  | I_BALANCE => "BALANCE" % string
  | I_CAR => "CAR" % string
  | I_CDR => "CDR" % string
  | I_CHAIN_ID => "CHAIN_ID" % string
  | I_CHECK_SIGNATURE => "CHECK_SIGNATURE" % string
  | I_COMPARE => "COMPARE" % string
  | I_CONCAT => "CONCAT" % string
  | I_CONS => "CONS" % string
  | I_CREATE_ACCOUNT => "CREATE_ACCOUNT" % string
  | I_CREATE_CONTRACT => "CREATE_CONTRACT" % string
  | I_IMPLICIT_ACCOUNT => "IMPLICIT_ACCOUNT" % string
  | I_DIP => "DIP" % string
  | I_DROP => "DROP" % string
  | I_DUP => "DUP" % string
  | I_EDIV => "EDIV" % string
  | I_EMPTY_BIG_MAP => "EMPTY_BIG_MAP" % string
  | I_EMPTY_MAP => "EMPTY_MAP" % string
  | I_EMPTY_SET => "EMPTY_SET" % string
  | I_EQ => "EQ" % string
  | I_EXEC => "EXEC" % string
  | I_APPLY => "APPLY" % string
  | I_FAILWITH => "FAILWITH" % string
  | I_GE => "GE" % string
  | I_GET => "GET" % string
  | I_GT => "GT" % string
  | I_HASH_KEY => "HASH_KEY" % string
  | I_IF => "IF" % string
  | I_IF_CONS => "IF_CONS" % string
  | I_IF_LEFT => "IF_LEFT" % string
  | I_IF_NONE => "IF_NONE" % string
  | I_INT => "INT" % string
  | I_LAMBDA => "LAMBDA" % string
  | I_LE => "LE" % string
  | I_LEFT => "LEFT" % string
  | I_LOOP => "LOOP" % string
  | I_LSL => "LSL" % string
  | I_LSR => "LSR" % string
  | I_LT => "LT" % string
  | I_MAP => "MAP" % string
  | I_MEM => "MEM" % string
  | I_MUL => "MUL" % string
  | I_NEG => "NEG" % string
  | I_NEQ => "NEQ" % string
  | I_NIL => "NIL" % string
  | I_NONE => "NONE" % string
  | I_NOT => "NOT" % string
  | I_NOW => "NOW" % string
  | I_OR => "OR" % string
  | I_PAIR => "PAIR" % string
  | I_PUSH => "PUSH" % string
  | I_RIGHT => "RIGHT" % string
  | I_SIZE => "SIZE" % string
  | I_SOME => "SOME" % string
  | I_SOURCE => "SOURCE" % string
  | I_SENDER => "SENDER" % string
  | I_SELF => "SELF" % string
  | I_SLICE => "SLICE" % string
  | I_STEPS_TO_QUOTA => "STEPS_TO_QUOTA" % string
  | I_SUB => "SUB" % string
  | I_SWAP => "SWAP" % string
  | I_TRANSFER_TOKENS => "TRANSFER_TOKENS" % string
  | I_SET_DELEGATE => "SET_DELEGATE" % string
  | I_UNIT => "UNIT" % string
  | I_UPDATE => "UPDATE" % string
  | I_XOR => "XOR" % string
  | I_ITER => "ITER" % string
  | I_LOOP_LEFT => "LOOP_LEFT" % string
  | I_ADDRESS => "ADDRESS" % string
  | I_CONTRACT => "CONTRACT" % string
  | I_ISNAT => "ISNAT" % string
  | I_CAST => "CAST" % string
  | I_RENAME => "RENAME" % string
  | I_DIG => "DIG" % string
  | I_DUG => "DUG" % string
  | T_bool => "bool" % string
  | T_contract => "contract" % string
  | T_int => "int" % string
  | T_key => "key" % string
  | T_key_hash => "key_hash" % string
  | T_lambda => "lambda" % string
  | T_list => "list" % string
  | T_map => "map" % string
  | T_big_map => "big_map" % string
  | T_nat => "nat" % string
  | T_option => "option" % string
  | T_or => "or" % string
  | T_pair => "pair" % string
  | T_set => "set" % string
  | T_signature => "signature" % string
  | T_string => "string" % string
  | T_bytes => "bytes" % string
  | T_mutez => "mutez" % string
  | T_timestamp => "timestamp" % string
  | T_unit => "unit" % string
  | T_operation => "operation" % string
  | T_address => "address" % string
  | T_chain_id => "chain_id" % string
  end.

Definition prim_of_string (function_parameter : string)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult prim :=
  match function_parameter with
  | "parameter" % string => ok K_parameter
  | "storage" % string => ok K_storage
  | "code" % string => ok K_code
  | "False" % string => ok D_False
  | "Elt" % string => ok D_Elt
  | "Left" % string => ok D_Left
  | "None" % string => ok D_None
  | "Pair" % string => ok D_Pair
  | "Right" % string => ok D_Right
  | "Some" % string => ok D_Some
  | "True" % string => ok D_True
  | "Unit" % string => ok D_Unit
  | "PACK" % string => ok I_PACK
  | "UNPACK" % string => ok I_UNPACK
  | "BLAKE2B" % string => ok I_BLAKE2B
  | "SHA256" % string => ok I_SHA256
  | "SHA512" % string => ok I_SHA512
  | "ABS" % string => ok I_ABS
  | "ADD" % string => ok I_ADD
  | "AMOUNT" % string => ok I_AMOUNT
  | "AND" % string => ok I_AND
  | "BALANCE" % string => ok I_BALANCE
  | "CAR" % string => ok I_CAR
  | "CDR" % string => ok I_CDR
  | "CHAIN_ID" % string => ok I_CHAIN_ID
  | "CHECK_SIGNATURE" % string => ok I_CHECK_SIGNATURE
  | "COMPARE" % string => ok I_COMPARE
  | "CONCAT" % string => ok I_CONCAT
  | "CONS" % string => ok I_CONS
  | "CREATE_ACCOUNT" % string => ok I_CREATE_ACCOUNT
  | "CREATE_CONTRACT" % string => ok I_CREATE_CONTRACT
  | "IMPLICIT_ACCOUNT" % string => ok I_IMPLICIT_ACCOUNT
  | "DIP" % string => ok I_DIP
  | "DROP" % string => ok I_DROP
  | "DUP" % string => ok I_DUP
  | "EDIV" % string => ok I_EDIV
  | "EMPTY_BIG_MAP" % string => ok I_EMPTY_BIG_MAP
  | "EMPTY_MAP" % string => ok I_EMPTY_MAP
  | "EMPTY_SET" % string => ok I_EMPTY_SET
  | "EQ" % string => ok I_EQ
  | "EXEC" % string => ok I_EXEC
  | "APPLY" % string => ok I_APPLY
  | "FAILWITH" % string => ok I_FAILWITH
  | "GE" % string => ok I_GE
  | "GET" % string => ok I_GET
  | "GT" % string => ok I_GT
  | "HASH_KEY" % string => ok I_HASH_KEY
  | "IF" % string => ok I_IF
  | "IF_CONS" % string => ok I_IF_CONS
  | "IF_LEFT" % string => ok I_IF_LEFT
  | "IF_NONE" % string => ok I_IF_NONE
  | "INT" % string => ok I_INT
  | "LAMBDA" % string => ok I_LAMBDA
  | "LE" % string => ok I_LE
  | "LEFT" % string => ok I_LEFT
  | "LOOP" % string => ok I_LOOP
  | "LSL" % string => ok I_LSL
  | "LSR" % string => ok I_LSR
  | "LT" % string => ok I_LT
  | "MAP" % string => ok I_MAP
  | "MEM" % string => ok I_MEM
  | "MUL" % string => ok I_MUL
  | "NEG" % string => ok I_NEG
  | "NEQ" % string => ok I_NEQ
  | "NIL" % string => ok I_NIL
  | "NONE" % string => ok I_NONE
  | "NOT" % string => ok I_NOT
  | "NOW" % string => ok I_NOW
  | "OR" % string => ok I_OR
  | "PAIR" % string => ok I_PAIR
  | "PUSH" % string => ok I_PUSH
  | "RIGHT" % string => ok I_RIGHT
  | "SIZE" % string => ok I_SIZE
  | "SOME" % string => ok I_SOME
  | "SOURCE" % string => ok I_SOURCE
  | "SENDER" % string => ok I_SENDER
  | "SELF" % string => ok I_SELF
  | "SLICE" % string => ok I_SLICE
  | "STEPS_TO_QUOTA" % string => ok I_STEPS_TO_QUOTA
  | "SUB" % string => ok I_SUB
  | "SWAP" % string => ok I_SWAP
  | "TRANSFER_TOKENS" % string => ok I_TRANSFER_TOKENS
  | "SET_DELEGATE" % string => ok I_SET_DELEGATE
  | "UNIT" % string => ok I_UNIT
  | "UPDATE" % string => ok I_UPDATE
  | "XOR" % string => ok I_XOR
  | "ITER" % string => ok I_ITER
  | "LOOP_LEFT" % string => ok I_LOOP_LEFT
  | "ADDRESS" % string => ok I_ADDRESS
  | "CONTRACT" % string => ok I_CONTRACT
  | "ISNAT" % string => ok I_ISNAT
  | "CAST" % string => ok I_CAST
  | "RENAME" % string => ok I_RENAME
  | "DIG" % string => ok I_DIG
  | "DUG" % string => ok I_DUG
  | "bool" % string => ok T_bool
  | "contract" % string => ok T_contract
  | "int" % string => ok T_int
  | "key" % string => ok T_key
  | "key_hash" % string => ok T_key_hash
  | "lambda" % string => ok T_lambda
  | "list" % string => ok T_list
  | "map" % string => ok T_map
  | "big_map" % string => ok T_big_map
  | "nat" % string => ok T_nat
  | "option" % string => ok T_option
  | "or" % string => ok T_or
  | "pair" % string => ok T_pair
  | "set" % string => ok T_set
  | "signature" % string => ok T_signature
  | "string" % string => ok T_string
  | "bytes" % string => ok T_bytes
  | "mutez" % string => ok T_mutez
  | "timestamp" % string => ok T_timestamp
  | "unit" % string => ok T_unit
  | "operation" % string => ok T_operation
  | "address" % string => ok T_address
  | "chain_id" % string => ok T_chain_id
  | n =>
    if valid_case n then
      __error_value
        (Tezos_protocol_environment_alpha__Environment.Error_monad.Unknown_primitive_name
          n)
    else
      __error_value
        (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_case
          n)
  end.

Definition prims_of_strings
  (expr :
    Tezos_protocol_environment_alpha__Environment.Micheline.canonical string)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (Tezos_protocol_environment_alpha__Environment.Micheline.canonical prim) :=
  let fix convert
    (function_parameter :
    Tezos_protocol_environment_alpha__Environment.Micheline.node
      Tezos_protocol_environment_alpha__Environment.Micheline.canonical_location
      string)
    : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_protocol_environment_alpha__Environment.Micheline.node
        Tezos_protocol_environment_alpha__Environment.Micheline.canonical_location
        prim) :=
    match function_parameter with
    |
      (Tezos_protocol_environment_alpha__Environment.Micheline.Int _ _ |
        Tezos_protocol_environment_alpha__Environment.Micheline.String _ _ |
        Tezos_protocol_environment_alpha__Environment.Micheline.Bytes _ _) as
        expr => ok expr
    |
      Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc prim args
        annot =>
      op_gtgtquestion
        (Error_monad.record_trace
          (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_primitive_name
            expr loc) (prim_of_string prim))
        (fun prim =>
          op_gtgtquestion
            (List.fold_left
              (fun acc =>
                fun arg =>
                  op_gtgtquestion acc
                    (fun args =>
                      op_gtgtquestion (convert arg)
                        (fun arg => ok (cons arg args)))) (ok []) args)
            (fun args =>
              ok
                (Tezos_protocol_environment_alpha__Environment.Micheline.Prim 0
                  prim (List.rev args) annot)))
    | Tezos_protocol_environment_alpha__Environment.Micheline.Seq _ args =>
      op_gtgtquestion
        (List.fold_left
          (fun acc =>
            fun arg =>
              op_gtgtquestion acc
                (fun args =>
                  op_gtgtquestion (convert arg) (fun arg => ok (cons arg args))))
          (ok []) args)
        (fun args =>
          ok
            (Tezos_protocol_environment_alpha__Environment.Micheline.Seq 0
              (List.rev args)))
    end in
  op_gtgtquestion (convert (root expr)) (fun expr => ok (strip_locations expr)).

Definition strings_of_prims
  (expr : Tezos_protocol_environment_alpha__Environment.Micheline.canonical prim)
  : Tezos_protocol_environment_alpha__Environment.Micheline.canonical string :=
  let fix convert
    (function_parameter :
    Tezos_protocol_environment_alpha__Environment.Micheline.node Z prim)
    : Tezos_protocol_environment_alpha__Environment.Micheline.node Z string :=
    match function_parameter with
    |
      (Tezos_protocol_environment_alpha__Environment.Micheline.Int _ _ |
        Tezos_protocol_environment_alpha__Environment.Micheline.String _ _ |
        Tezos_protocol_environment_alpha__Environment.Micheline.Bytes _ _) as
        expr => expr
    |
      Tezos_protocol_environment_alpha__Environment.Micheline.Prim _ prim args
        annot =>
      let prim := string_of_prim prim in
      let args := List.map convert args in
      Tezos_protocol_environment_alpha__Environment.Micheline.Prim 0 prim args
        annot
    | Tezos_protocol_environment_alpha__Environment.Micheline.Seq _ args =>
      let args := List.map convert args in
      Tezos_protocol_environment_alpha__Environment.Micheline.Seq 0 args
    end in
  strip_locations (convert (root expr)).

Definition prim_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding prim :=
  op_atat
    (let arg := def "michelson.v1.primitives" % string in
    fun eta => arg None None eta)
    (string_enum
      (cons ("parameter" % string, K_parameter)
        (cons ("storage" % string, K_storage)
          (cons ("code" % string, K_code)
            (cons ("False" % string, D_False)
              (cons ("Elt" % string, D_Elt)
                (cons ("Left" % string, D_Left)
                  (cons ("None" % string, D_None)
                    (cons ("Pair" % string, D_Pair)
                      (cons ("Right" % string, D_Right)
                        (cons ("Some" % string, D_Some)
                          (cons ("True" % string, D_True)
                            (cons ("Unit" % string, D_Unit)
                              (cons ("PACK" % string, I_PACK)
                                (cons ("UNPACK" % string, I_UNPACK)
                                  (cons ("BLAKE2B" % string, I_BLAKE2B)
                                    (cons ("SHA256" % string, I_SHA256)
                                      (cons ("SHA512" % string, I_SHA512)
                                        (cons ("ABS" % string, I_ABS)
                                          (cons ("ADD" % string, I_ADD)
                                            (cons ("AMOUNT" % string, I_AMOUNT)
                                              (cons ("AND" % string, I_AND)
                                                (cons
                                                  ("BALANCE" % string, I_BALANCE)
                                                  (cons ("CAR" % string, I_CAR)
                                                    (cons
                                                      ("CDR" % string, I_CDR)
                                                      (cons
                                                        ("CHECK_SIGNATURE" %
                                                          string,
                                                          I_CHECK_SIGNATURE)
                                                        (cons
                                                          ("COMPARE" % string,
                                                            I_COMPARE)
                                                          (cons
                                                            ("CONCAT" % string,
                                                              I_CONCAT)
                                                            (cons
                                                              ("CONS" % string,
                                                                I_CONS)
                                                              (cons
                                                                ("CREATE_ACCOUNT"
                                                                  % string,
                                                                  I_CREATE_ACCOUNT)
                                                                (cons
                                                                  ("CREATE_CONTRACT"
                                                                    % string,
                                                                    I_CREATE_CONTRACT)
                                                                  (cons
                                                                    ("IMPLICIT_ACCOUNT"
                                                                      % string,
                                                                      I_IMPLICIT_ACCOUNT)
                                                                    (cons
                                                                      ("DIP" %
                                                                        string,
                                                                        I_DIP)
                                                                      (cons
                                                                        ("DROP"
                                                                          %
                                                                          string,
                                                                          I_DROP)
                                                                        (cons
                                                                          ("DUP"
                                                                            %
                                                                            string,
                                                                            I_DUP)
                                                                          (cons
                                                                            ("EDIV"
                                                                              %
                                                                              string,
                                                                              I_EDIV)
                                                                            (cons
                                                                              ("EMPTY_MAP"
                                                                                %
                                                                                string,
                                                                                I_EMPTY_MAP)
                                                                              (cons
                                                                                ("EMPTY_SET"
                                                                                  %
                                                                                  string,
                                                                                  I_EMPTY_SET)
                                                                                (cons
                                                                                  ("EQ"
                                                                                    %
                                                                                    string,
                                                                                    I_EQ)
                                                                                  (cons
                                                                                    ("EXEC"
                                                                                      %
                                                                                      string,
                                                                                      I_EXEC)
                                                                                    (cons
                                                                                      ("FAILWITH"
                                                                                        %
                                                                                        string,
                                                                                        I_FAILWITH)
                                                                                      (cons
                                                                                        ("GE"
                                                                                          %
                                                                                          string,
                                                                                          I_GE)
                                                                                        (cons
                                                                                          ("GET"
                                                                                            %
                                                                                            string,
                                                                                            I_GET)
                                                                                          (cons
                                                                                            ("GT"
                                                                                              %
                                                                                              string,
                                                                                              I_GT)
                                                                                            (cons
                                                                                              ("HASH_KEY"
                                                                                                %
                                                                                                string,
                                                                                                I_HASH_KEY)
                                                                                              (cons
                                                                                                ("IF"
                                                                                                  %
                                                                                                  string,
                                                                                                  I_IF)
                                                                                                (cons
                                                                                                  ("IF_CONS"
                                                                                                    %
                                                                                                    string,
                                                                                                    I_IF_CONS)
                                                                                                  (cons
                                                                                                    ("IF_LEFT"
                                                                                                      %
                                                                                                      string,
                                                                                                      I_IF_LEFT)
                                                                                                    (cons
                                                                                                      ("IF_NONE"
                                                                                                        %
                                                                                                        string,
                                                                                                        I_IF_NONE)
                                                                                                      (cons
                                                                                                        ("INT"
                                                                                                          %
                                                                                                          string,
                                                                                                          I_INT)
                                                                                                        (cons
                                                                                                          ("LAMBDA"
                                                                                                            %
                                                                                                            string,
                                                                                                            I_LAMBDA)
                                                                                                          (cons
                                                                                                            ("LE"
                                                                                                              %
                                                                                                              string,
                                                                                                              I_LE)
                                                                                                            (cons
                                                                                                              ("LEFT"
                                                                                                                %
                                                                                                                string,
                                                                                                                I_LEFT)
                                                                                                              (cons
                                                                                                                ("LOOP"
                                                                                                                  %
                                                                                                                  string,
                                                                                                                  I_LOOP)
                                                                                                                (cons
                                                                                                                  ("LSL"
                                                                                                                    %
                                                                                                                    string,
                                                                                                                    I_LSL)
                                                                                                                  (cons
                                                                                                                    ("LSR"
                                                                                                                      %
                                                                                                                      string,
                                                                                                                      I_LSR)
                                                                                                                    (cons
                                                                                                                      ("LT"
                                                                                                                        %
                                                                                                                        string,
                                                                                                                        I_LT)
                                                                                                                      (cons
                                                                                                                        ("MAP"
                                                                                                                          %
                                                                                                                          string,
                                                                                                                          I_MAP)
                                                                                                                        (cons
                                                                                                                          ("MEM"
                                                                                                                            %
                                                                                                                            string,
                                                                                                                            I_MEM)
                                                                                                                          (cons
                                                                                                                            ("MUL"
                                                                                                                              %
                                                                                                                              string,
                                                                                                                              I_MUL)
                                                                                                                            (cons
                                                                                                                              ("NEG"
                                                                                                                                %
                                                                                                                                string,
                                                                                                                                I_NEG)
                                                                                                                              (cons
                                                                                                                                ("NEQ"
                                                                                                                                  %
                                                                                                                                  string,
                                                                                                                                  I_NEQ)
                                                                                                                                (cons
                                                                                                                                  ("NIL"
                                                                                                                                    %
                                                                                                                                    string,
                                                                                                                                    I_NIL)
                                                                                                                                  (cons
                                                                                                                                    ("NONE"
                                                                                                                                      %
                                                                                                                                      string,
                                                                                                                                      I_NONE)
                                                                                                                                    (cons
                                                                                                                                      ("NOT"
                                                                                                                                        %
                                                                                                                                        string,
                                                                                                                                        I_NOT)
                                                                                                                                      (cons
                                                                                                                                        ("NOW"
                                                                                                                                          %
                                                                                                                                          string,
                                                                                                                                          I_NOW)
                                                                                                                                        (cons
                                                                                                                                          ("OR"
                                                                                                                                            %
                                                                                                                                            string,
                                                                                                                                            I_OR)
                                                                                                                                          (cons
                                                                                                                                            ("PAIR"
                                                                                                                                              %
                                                                                                                                              string,
                                                                                                                                              I_PAIR)
                                                                                                                                            (cons
                                                                                                                                              ("PUSH"
                                                                                                                                                %
                                                                                                                                                string,
                                                                                                                                                I_PUSH)
                                                                                                                                              (cons
                                                                                                                                                ("RIGHT"
                                                                                                                                                  %
                                                                                                                                                  string,
                                                                                                                                                  I_RIGHT)
                                                                                                                                                (cons
                                                                                                                                                  ("SIZE"
                                                                                                                                                    %
                                                                                                                                                    string,
                                                                                                                                                    I_SIZE)
                                                                                                                                                  (cons
                                                                                                                                                    ("SOME"
                                                                                                                                                      %
                                                                                                                                                      string,
                                                                                                                                                      I_SOME)
                                                                                                                                                    (cons
                                                                                                                                                      ("SOURCE"
                                                                                                                                                        %
                                                                                                                                                        string,
                                                                                                                                                        I_SOURCE)
                                                                                                                                                      (cons
                                                                                                                                                        ("SENDER"
                                                                                                                                                          %
                                                                                                                                                          string,
                                                                                                                                                          I_SENDER)
                                                                                                                                                        (cons
                                                                                                                                                          ("SELF"
                                                                                                                                                            %
                                                                                                                                                            string,
                                                                                                                                                            I_SELF)
                                                                                                                                                          (cons
                                                                                                                                                            ("STEPS_TO_QUOTA"
                                                                                                                                                              %
                                                                                                                                                              string,
                                                                                                                                                              I_STEPS_TO_QUOTA)
                                                                                                                                                            (cons
                                                                                                                                                              ("SUB"
                                                                                                                                                                %
                                                                                                                                                                string,
                                                                                                                                                                I_SUB)
                                                                                                                                                              (cons
                                                                                                                                                                ("SWAP"
                                                                                                                                                                  %
                                                                                                                                                                  string,
                                                                                                                                                                  I_SWAP)
                                                                                                                                                                (cons
                                                                                                                                                                  ("TRANSFER_TOKENS"
                                                                                                                                                                    %
                                                                                                                                                                    string,
                                                                                                                                                                    I_TRANSFER_TOKENS)
                                                                                                                                                                  (cons
                                                                                                                                                                    ("SET_DELEGATE"
                                                                                                                                                                      %
                                                                                                                                                                      string,
                                                                                                                                                                      I_SET_DELEGATE)
                                                                                                                                                                    (cons
                                                                                                                                                                      ("UNIT"
                                                                                                                                                                        %
                                                                                                                                                                        string,
                                                                                                                                                                        I_UNIT)
                                                                                                                                                                      (cons
                                                                                                                                                                        ("UPDATE"
                                                                                                                                                                          %
                                                                                                                                                                          string,
                                                                                                                                                                          I_UPDATE)
                                                                                                                                                                        (cons
                                                                                                                                                                          ("XOR"
                                                                                                                                                                            %
                                                                                                                                                                            string,
                                                                                                                                                                            I_XOR)
                                                                                                                                                                          (cons
                                                                                                                                                                            ("ITER"
                                                                                                                                                                              %
                                                                                                                                                                              string,
                                                                                                                                                                              I_ITER)
                                                                                                                                                                            (cons
                                                                                                                                                                              ("LOOP_LEFT"
                                                                                                                                                                                %
                                                                                                                                                                                string,
                                                                                                                                                                                I_LOOP_LEFT)
                                                                                                                                                                              (cons
                                                                                                                                                                                ("ADDRESS"
                                                                                                                                                                                  %
                                                                                                                                                                                  string,
                                                                                                                                                                                  I_ADDRESS)
                                                                                                                                                                                (cons
                                                                                                                                                                                  ("CONTRACT"
                                                                                                                                                                                    %
                                                                                                                                                                                    string,
                                                                                                                                                                                    I_CONTRACT)
                                                                                                                                                                                  (cons
                                                                                                                                                                                    ("ISNAT"
                                                                                                                                                                                      %
                                                                                                                                                                                      string,
                                                                                                                                                                                      I_ISNAT)
                                                                                                                                                                                    (cons
                                                                                                                                                                                      ("CAST"
                                                                                                                                                                                        %
                                                                                                                                                                                        string,
                                                                                                                                                                                        I_CAST)
                                                                                                                                                                                      (cons
                                                                                                                                                                                        ("RENAME"
                                                                                                                                                                                          %
                                                                                                                                                                                          string,
                                                                                                                                                                                          I_RENAME)
                                                                                                                                                                                        (cons
                                                                                                                                                                                          ("bool"
                                                                                                                                                                                            %
                                                                                                                                                                                            string,
                                                                                                                                                                                            T_bool)
                                                                                                                                                                                          (cons
                                                                                                                                                                                            ("contract"
                                                                                                                                                                                              %
                                                                                                                                                                                              string,
                                                                                                                                                                                              T_contract)
                                                                                                                                                                                            (cons
                                                                                                                                                                                              ("int"
                                                                                                                                                                                                %
                                                                                                                                                                                                string,
                                                                                                                                                                                                T_int)
                                                                                                                                                                                              (cons
                                                                                                                                                                                                ("key"
                                                                                                                                                                                                  %
                                                                                                                                                                                                  string,
                                                                                                                                                                                                  T_key)
                                                                                                                                                                                                (cons
                                                                                                                                                                                                  ("key_hash"
                                                                                                                                                                                                    %
                                                                                                                                                                                                    string,
                                                                                                                                                                                                    T_key_hash)
                                                                                                                                                                                                  (cons
                                                                                                                                                                                                    ("lambda"
                                                                                                                                                                                                      %
                                                                                                                                                                                                      string,
                                                                                                                                                                                                      T_lambda)
                                                                                                                                                                                                    (cons
                                                                                                                                                                                                      ("list"
                                                                                                                                                                                                        %
                                                                                                                                                                                                        string,
                                                                                                                                                                                                        T_list)
                                                                                                                                                                                                      (cons
                                                                                                                                                                                                        ("map"
                                                                                                                                                                                                          %
                                                                                                                                                                                                          string,
                                                                                                                                                                                                          T_map)
                                                                                                                                                                                                        (cons
                                                                                                                                                                                                          ("big_map"
                                                                                                                                                                                                            %
                                                                                                                                                                                                            string,
                                                                                                                                                                                                            T_big_map)
                                                                                                                                                                                                          (cons
                                                                                                                                                                                                            ("nat"
                                                                                                                                                                                                              %
                                                                                                                                                                                                              string,
                                                                                                                                                                                                              T_nat)
                                                                                                                                                                                                            (cons
                                                                                                                                                                                                              ("option"
                                                                                                                                                                                                                %
                                                                                                                                                                                                                string,
                                                                                                                                                                                                                T_option)
                                                                                                                                                                                                              (cons
                                                                                                                                                                                                                ("or"
                                                                                                                                                                                                                  %
                                                                                                                                                                                                                  string,
                                                                                                                                                                                                                  T_or)
                                                                                                                                                                                                                (cons
                                                                                                                                                                                                                  ("pair"
                                                                                                                                                                                                                    %
                                                                                                                                                                                                                    string,
                                                                                                                                                                                                                    T_pair)
                                                                                                                                                                                                                  (cons
                                                                                                                                                                                                                    ("set"
                                                                                                                                                                                                                      %
                                                                                                                                                                                                                      string,
                                                                                                                                                                                                                      T_set)
                                                                                                                                                                                                                    (cons
                                                                                                                                                                                                                      ("signature"
                                                                                                                                                                                                                        %
                                                                                                                                                                                                                        string,
                                                                                                                                                                                                                        T_signature)
                                                                                                                                                                                                                      (cons
                                                                                                                                                                                                                        ("string"
                                                                                                                                                                                                                          %
                                                                                                                                                                                                                          string,
                                                                                                                                                                                                                          T_string)
                                                                                                                                                                                                                        (cons
                                                                                                                                                                                                                          ("bytes"
                                                                                                                                                                                                                            %
                                                                                                                                                                                                                            string,
                                                                                                                                                                                                                            T_bytes)
                                                                                                                                                                                                                          (cons
                                                                                                                                                                                                                            ("mutez"
                                                                                                                                                                                                                              %
                                                                                                                                                                                                                              string,
                                                                                                                                                                                                                              T_mutez)
                                                                                                                                                                                                                            (cons
                                                                                                                                                                                                                              ("timestamp"
                                                                                                                                                                                                                                %
                                                                                                                                                                                                                                string,
                                                                                                                                                                                                                                T_timestamp)
                                                                                                                                                                                                                              (cons
                                                                                                                                                                                                                                ("unit"
                                                                                                                                                                                                                                  %
                                                                                                                                                                                                                                  string,
                                                                                                                                                                                                                                  T_unit)
                                                                                                                                                                                                                                (cons
                                                                                                                                                                                                                                  ("operation"
                                                                                                                                                                                                                                    %
                                                                                                                                                                                                                                    string,
                                                                                                                                                                                                                                    T_operation)
                                                                                                                                                                                                                                  (cons
                                                                                                                                                                                                                                    ("address"
                                                                                                                                                                                                                                      %
                                                                                                                                                                                                                                      string,
                                                                                                                                                                                                                                      T_address)
                                                                                                                                                                                                                                    (cons
                                                                                                                                                                                                                                      ("SLICE"
                                                                                                                                                                                                                                        %
                                                                                                                                                                                                                                        string,
                                                                                                                                                                                                                                        I_SLICE)
                                                                                                                                                                                                                                      (cons
                                                                                                                                                                                                                                        ("DIG"
                                                                                                                                                                                                                                          %
                                                                                                                                                                                                                                          string,
                                                                                                                                                                                                                                          I_DIG)
                                                                                                                                                                                                                                        (cons
                                                                                                                                                                                                                                          ("DUG"
                                                                                                                                                                                                                                            %
                                                                                                                                                                                                                                            string,
                                                                                                                                                                                                                                            I_DUG)
                                                                                                                                                                                                                                          (cons
                                                                                                                                                                                                                                            ("EMPTY_BIG_MAP"
                                                                                                                                                                                                                                              %
                                                                                                                                                                                                                                              string,
                                                                                                                                                                                                                                              I_EMPTY_BIG_MAP)
                                                                                                                                                                                                                                            (cons
                                                                                                                                                                                                                                              ("APPLY"
                                                                                                                                                                                                                                                %
                                                                                                                                                                                                                                                string,
                                                                                                                                                                                                                                                I_APPLY)
                                                                                                                                                                                                                                              (cons
                                                                                                                                                                                                                                                ("chain_id"
                                                                                                                                                                                                                                                  %
                                                                                                                                                                                                                                                  string,
                                                                                                                                                                                                                                                  T_chain_id)
                                                                                                                                                                                                                                                (cons
                                                                                                                                                                                                                                                  ("CHAIN_ID"
                                                                                                                                                                                                                                                    %
                                                                                                                                                                                                                                                    string,
                                                                                                                                                                                                                                                    I_CHAIN_ID)
                                                                                                                                                                                                                                                  []))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))).

(* ❌ Top-level evaluations are considered as an error as sources of side-effects *)
Compute
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.unknown_primitive_name" % string
      "Unknown primitive name" % string
      "In a script or data expression, a primitive was unknown." % string
      (Some
        (fun ppf =>
          fun n =>
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Unknown primitive " % string
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String
                    Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Char_literal
                      "." % char
                      Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))
                "Unknown primitive %s." % string) n))
      (obj1 (req None None "wrong_primitive_name" % string __string_value))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Unknown_primitive_name
            got => Some got
        | _ => None
        end)
      (fun got =>
        Tezos_protocol_environment_alpha__Environment.Error_monad.Unknown_primitive_name
          got) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.invalid_primitive_name_case" % string
      "Invalid primitive name case" % string
      "In a script or data expression, a primitive name is neither uppercase, lowercase or capitalized."
        % string
      (Some
        (fun ppf =>
          fun n =>
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Primitive " % string
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String
                    Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                      " has invalid case." % string
                      Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))
                "Primitive %s has invalid case." % string) n))
      (obj1 (req None None "wrong_primitive_name" % string __string_value))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_case
            name => Some name
        | _ => None
        end)
      (fun name =>
        Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_case
          name) in
  register_error_kind
    (* ❌ Variants not supported *)
    variant "michelson_v1.invalid_primitive_name" % string
    "Invalid primitive name" % string
    "In a script or data expression, a primitive name is unknown or has a wrong case."
      % string
    (Some
      (fun ppf =>
        fun function_parameter =>
          let '_ := function_parameter in
          Format.fprintf ppf
            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                "Invalid primitive." % string
                Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
              "Invalid primitive." % string)))
    (obj2
      (req None None "expression" % string
        (Micheline.canonical_encoding "generic" % string __string_value))
      (req None None "location" % string Micheline.canonical_location_encoding))
    (fun function_parameter =>
      match function_parameter with
      |
        Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_primitive_name
          expr loc => Some (expr, loc)
      | _ => None
      end)
    (fun function_parameter =>
      let '(expr, loc) := function_parameter in
      Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_primitive_name
        expr loc).

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

type error += Unknown_primitive_name of string (* `Permanent *)

type error += Invalid_case of string (* `Permanent *)

type error +=
  | Invalid_primitive_name of
      string Micheline.canonical * Micheline.canonical_location

(* `Permanent *)

type prim =
  | K_parameter
  | K_storage
  | K_code
  | D_False
  | D_Elt
  | D_Left
  | D_None
  | D_Pair
  | D_Right
  | D_Some
  | D_True
  | D_Unit
  | I_PACK
  | I_UNPACK
  | I_BLAKE2B
  | I_SHA256
  | I_SHA512
  | I_ABS
  | I_ADD
  | I_AMOUNT
  | I_AND
  | I_BALANCE
  | I_CAR
  | I_CDR
  | I_CHAIN_ID
  | I_CHECK_SIGNATURE
  | I_COMPARE
  | I_CONCAT
  | I_CONS
  | I_CREATE_ACCOUNT
  | I_CREATE_CONTRACT
  | I_IMPLICIT_ACCOUNT
  | I_DIP
  | I_DROP
  | I_DUP
  | I_EDIV
  | I_EMPTY_BIG_MAP
  | I_EMPTY_MAP
  | I_EMPTY_SET
  | I_EQ
  | I_EXEC
  | I_APPLY
  | I_FAILWITH
  | I_GE
  | I_GET
  | I_GT
  | I_HASH_KEY
  | I_IF
  | I_IF_CONS
  | I_IF_LEFT
  | I_IF_NONE
  | I_INT
  | I_LAMBDA
  | I_LE
  | I_LEFT
  | I_LOOP
  | I_LSL
  | I_LSR
  | I_LT
  | I_MAP
  | I_MEM
  | I_MUL
  | I_NEG
  | I_NEQ
  | I_NIL
  | I_NONE
  | I_NOT
  | I_NOW
  | I_OR
  | I_PAIR
  | I_PUSH
  | I_RIGHT
  | I_SIZE
  | I_SOME
  | I_SOURCE
  | I_SENDER
  | I_SELF
  | I_SLICE
  | I_STEPS_TO_QUOTA
  | I_SUB
  | I_SWAP
  | I_TRANSFER_TOKENS
  | I_SET_DELEGATE
  | I_UNIT
  | I_UPDATE
  | I_XOR
  | I_ITER
  | I_LOOP_LEFT
  | I_ADDRESS
  | I_CONTRACT
  | I_ISNAT
  | I_CAST
  | I_RENAME
  | I_DIG
  | I_DUG
  | T_bool
  | T_contract
  | T_int
  | T_key
  | T_key_hash
  | T_lambda
  | T_list
  | T_map
  | T_big_map
  | T_nat
  | T_option
  | T_or
  | T_pair
  | T_set
  | T_signature
  | T_string
  | T_bytes
  | T_mutez
  | T_timestamp
  | T_unit
  | T_operation
  | T_address
  | T_chain_id

val prim_encoding : prim Data_encoding.encoding

val string_of_prim : prim -> string

val prim_of_string : string -> prim tzresult

val prims_of_strings :
  string Micheline.canonical -> prim Micheline.canonical tzresult

val strings_of_prims : prim Micheline.canonical -> string Micheline.canonical

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

(* extensible_type Tezos_protocol_environment_alpha__Environment.Error_monad.error *)

(* extensible_type Tezos_protocol_environment_alpha__Environment.Error_monad.error *)

(* extensible_type Tezos_protocol_environment_alpha__Environment.Error_monad.error *)

Inductive prim : Set :=
| K_parameter : prim
| K_storage : prim
| K_code : prim
| D_False : prim
| D_Elt : prim
| D_Left : prim
| D_None : prim
| D_Pair : prim
| D_Right : prim
| D_Some : prim
| D_True : prim
| D_Unit : prim
| I_PACK : prim
| I_UNPACK : prim
| I_BLAKE2B : prim
| I_SHA256 : prim
| I_SHA512 : prim
| I_ABS : prim
| I_ADD : prim
| I_AMOUNT : prim
| I_AND : prim
| I_BALANCE : prim
| I_CAR : prim
| I_CDR : prim
| I_CHAIN_ID : prim
| I_CHECK_SIGNATURE : prim
| I_COMPARE : prim
| I_CONCAT : prim
| I_CONS : prim
| I_CREATE_ACCOUNT : prim
| I_CREATE_CONTRACT : prim
| I_IMPLICIT_ACCOUNT : prim
| I_DIP : prim
| I_DROP : prim
| I_DUP : prim
| I_EDIV : prim
| I_EMPTY_BIG_MAP : prim
| I_EMPTY_MAP : prim
| I_EMPTY_SET : prim
| I_EQ : prim
| I_EXEC : prim
| I_APPLY : prim
| I_FAILWITH : prim
| I_GE : prim
| I_GET : prim
| I_GT : prim
| I_HASH_KEY : prim
| I_IF : prim
| I_IF_CONS : prim
| I_IF_LEFT : prim
| I_IF_NONE : prim
| I_INT : prim
| I_LAMBDA : prim
| I_LE : prim
| I_LEFT : prim
| I_LOOP : prim
| I_LSL : prim
| I_LSR : prim
| I_LT : prim
| I_MAP : prim
| I_MEM : prim
| I_MUL : prim
| I_NEG : prim
| I_NEQ : prim
| I_NIL : prim
| I_NONE : prim
| I_NOT : prim
| I_NOW : prim
| I_OR : prim
| I_PAIR : prim
| I_PUSH : prim
| I_RIGHT : prim
| I_SIZE : prim
| I_SOME : prim
| I_SOURCE : prim
| I_SENDER : prim
| I_SELF : prim
| I_SLICE : prim
| I_STEPS_TO_QUOTA : prim
| I_SUB : prim
| I_SWAP : prim
| I_TRANSFER_TOKENS : prim
| I_SET_DELEGATE : prim
| I_UNIT : prim
| I_UPDATE : prim
| I_XOR : prim
| I_ITER : prim
| I_LOOP_LEFT : prim
| I_ADDRESS : prim
| I_CONTRACT : prim
| I_ISNAT : prim
| I_CAST : prim
| I_RENAME : prim
| I_DIG : prim
| I_DUG : prim
| T_bool : prim
| T_contract : prim
| T_int : prim
| T_key : prim
| T_key_hash : prim
| T_lambda : prim
| T_list : prim
| T_map : prim
| T_big_map : prim
| T_nat : prim
| T_option : prim
| T_or : prim
| T_pair : prim
| T_set : prim
| T_signature : prim
| T_string : prim
| T_bytes : prim
| T_mutez : prim
| T_timestamp : prim
| T_unit : prim
| T_operation : prim
| T_address : prim
| T_chain_id : prim.

Parameter prim_encoding :
  Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding prim.

Parameter string_of_prim : prim -> string.

Parameter prim_of_string :
  string ->
  Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult prim.

Parameter prims_of_strings :
  Tezos_protocol_environment_alpha__Environment.Micheline.canonical string ->
  Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (Tezos_protocol_environment_alpha__Environment.Micheline.canonical prim).

Parameter strings_of_prims :
  Tezos_protocol_environment_alpha__Environment.Micheline.canonical prim ->
  Tezos_protocol_environment_alpha__Environment.Micheline.canonical string.

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

type 'a lazyt = unit -> 'a

type 'a lazy_list_t = LCons of 'a * 'a lazy_list_t tzresult Lwt.t lazyt

type 'a lazy_list = 'a lazy_list_t tzresult Lwt.t

let rec ( --> ) i j =
  (* [i; i+1; ...; j] *)
  if Compare.Int.(i > j) then [] else i :: (succ i --> j)

let rec ( ---> ) i j =
  (* [i; i+1; ...; j] *)
  if Compare.Int32.(i > j) then [] else i :: (Int32.succ i ---> j)

let split delim ?(limit = max_int) path =
  let l = String.length path in
  let rec do_slashes acc limit i =
    if Compare.Int.(i >= l) then List.rev acc
    else if Compare.Char.(path.[i] = delim) then do_slashes acc limit (i + 1)
    else do_split acc limit i
  and do_split acc limit i =
    if Compare.Int.(limit <= 0) then
      if Compare.Int.(i = l) then List.rev acc
      else List.rev (String.sub path i (l - i) :: acc)
    else do_component acc (pred limit) i i
  and do_component acc limit i j =
    if Compare.Int.(j >= l) then
      if Compare.Int.(i = j) then List.rev acc
      else List.rev (String.sub path i (j - i) :: acc)
    else if Compare.Char.(path.[j] = delim) then
      do_slashes (String.sub path i (j - i) :: acc) limit j
    else do_component acc limit i (j + 1)
  in
  if Compare.Int.(limit > 0) then do_slashes [] limit 0 else [path]

let pp_print_paragraph ppf description =
  Format.fprintf
    ppf
    "@[%a@]"
    Format.(pp_print_list ~pp_sep:pp_print_space pp_print_string)
    (split ' ' description)

let take n l =
  let rec loop acc n = function
    | xs when Compare.Int.(n <= 0) ->
        Some (List.rev acc, xs)
    | [] ->
        None
    | x :: xs ->
        loop (x :: acc) (n - 1) xs
  in
  loop [] n l

let remove_prefix ~prefix s =
  let x = String.length prefix in
  let n = String.length s in
  if Compare.Int.(n >= x) && Compare.String.(String.sub s 0 x = prefix) then
    Some (String.sub s x (n - x))
  else None

let rec remove_elem_from_list nb = function
  | [] ->
      []
  | l when Compare.Int.(nb <= 0) ->
      l
  | _ :: tl ->
      remove_elem_from_list (nb - 1) tl

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Definition lazyt (a : Set) := unit -> a.

Inductive lazy_list_t (a : Set) : Set :=
| LCons :
  a ->
  lazyt
    (Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (lazy_list_t a))) -> lazy_list_t a.

Arguments LCons {_}.

Definition lazy_list (a : Set) :=
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (lazy_list_t a)).

Fixpoint op_minusminusgt
  (i : Tezos_protocol_environment_alpha__Environment.Compare.Int.t)
  (j : Tezos_protocol_environment_alpha__Environment.Compare.Int.t)
  : list Tezos_protocol_environment_alpha__Environment.Compare.Int.t :=
  if op_gt i j then
    []
  else
    cons i (op_minusminusgt (succ i) j).

Fixpoint op_minusminusminusgt
  (i : Tezos_protocol_environment_alpha__Environment.Compare.Int32.t)
  (j : Tezos_protocol_environment_alpha__Environment.Compare.Int32.t)
  : list Tezos_protocol_environment_alpha__Environment.Compare.Int32.t :=
  if op_gt i j then
    []
  else
    cons i (op_minusminusminusgt (Int32.succ i) j).

Definition split
  (delim : Tezos_protocol_environment_alpha__Environment.Compare.Char.t)
  (op_staroptstar :
    option Tezos_protocol_environment_alpha__Environment.Compare.Int.t)
  : string -> list string :=
  let limit :=
    match op_staroptstar with
    | Some op_starsthstar => op_starsthstar
    | None => max_int
    end in
  fun path =>
    let l := String.length path in
    let fix do_slashes
      (acc : list string) (limit :
      Tezos_protocol_environment_alpha__Environment.Compare.Int.t) (i :
      Tezos_protocol_environment_alpha__Environment.Compare.Int.t)
      : list string :=
      if op_gteq i l then
        List.rev acc
      else
        if op_eq (String.get path i) delim then
          do_slashes acc limit (op_plus i 1)
        else
          do_split acc limit i
    with do_split
      (acc : list string) (limit :
      Tezos_protocol_environment_alpha__Environment.Compare.Int.t) (i :
      Tezos_protocol_environment_alpha__Environment.Compare.Int.t)
      : list string :=
      if op_lteq limit 0 then
        if op_eq i l then
          List.rev acc
        else
          List.rev (cons (String.sub path i (op_minus l i)) acc)
      else
        do_component acc (pred limit) i i
    with do_component
      (acc : list string) (limit :
      Tezos_protocol_environment_alpha__Environment.Compare.Int.t) (i :
      Tezos_protocol_environment_alpha__Environment.Compare.Int.t) (j :
      Tezos_protocol_environment_alpha__Environment.Compare.Int.t)
      : list string :=
      if op_gteq j l then
        if op_eq i j then
          List.rev acc
        else
          List.rev (cons (String.sub path i (op_minus j i)) acc)
      else
        if op_eq (String.get path j) delim then
          do_slashes (cons (String.sub path i (op_minus j i)) acc) limit j
        else
          do_component acc limit i (op_plus j 1) in
    if op_gt limit 0 then
      do_slashes [] limit 0
    else
      cons path [].

Definition pp_print_paragraph
  (ppf : Tezos_protocol_environment_alpha__Environment.Format.formatter)
  (description : string) : unit :=
  Format.fprintf ppf
    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Formatting_gen
        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Open_box
          (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
            Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format
            "" % string))
        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
          (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Formatting_lit
            Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Close_box
            Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))
      "@[%a@]" % string) (pp_print_list (Some pp_print_space) pp_print_string)
    (split " " % char None description).

Definition take {A : Set}
  (n : Tezos_protocol_environment_alpha__Environment.Compare.Int.t) (l : list A)
  : option (list A * list A) :=
  let fix loop {B : Set}
    (acc : list B) (n :
    Tezos_protocol_environment_alpha__Environment.Compare.Int.t)
    (function_parameter : list B) : option (list B * list B) :=
    match function_parameter with
    | xs => Some ((List.rev acc), xs)
    | [] => None
    | cons x xs => loop (cons x acc) (op_minus n 1) xs
    end in
  loop [] n l.

Definition remove_prefix
  (prefix : Tezos_protocol_environment_alpha__Environment.Compare.String.t)
  (s : string) : option string :=
  let x := String.length prefix in
  let n := String.length s in
  if op_andand (op_gteq n x) (op_eq (String.sub s 0 x) prefix) then
    Some (String.sub s x (op_minus n x))
  else
    None.

Fixpoint remove_elem_from_list {A : Set}
  (nb : Tezos_protocol_environment_alpha__Environment.Compare.Int.t)
  (function_parameter : list A) : list A :=
  match function_parameter with
  | [] => []
  | l => l
  | cons _ tl => remove_elem_from_list (op_minus nb 1) tl
  end.

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

(** {2 Helper functions} *)

type 'a lazyt = unit -> 'a

type 'a lazy_list_t = LCons of 'a * 'a lazy_list_t tzresult Lwt.t lazyt

type 'a lazy_list = 'a lazy_list_t tzresult Lwt.t

(** Include bounds *)
val ( --> ) : int -> int -> int list

val ( ---> ) : Int32.t -> Int32.t -> Int32.t list

val pp_print_paragraph : Format.formatter -> string -> unit

val take : int -> 'a list -> ('a list * 'a list) option

(** Some (input with [prefix] removed), if string has [prefix], else [None] *)
val remove_prefix : prefix:string -> string -> string option

(** [remove nb list] remove the first [nb] elements from the list [list]. *)
val remove_elem_from_list : int -> 'a list -> 'a list

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Definition lazyt (a : Set) := unit -> a.

Inductive lazy_list_t (a : Set) : Set :=
| LCons :
  a ->
  lazyt
    (Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (lazy_list_t a))) -> lazy_list_t a.

Arguments LCons {_}.

Definition lazy_list (a : Set) :=
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (lazy_list_t a)).

Parameter op_minusminusgt : Z -> Z -> list Z.

Parameter op_minusminusminusgt :
  Tezos_protocol_environment_alpha__Environment.Int32.t ->
  Tezos_protocol_environment_alpha__Environment.Int32.t ->
  list Tezos_protocol_environment_alpha__Environment.Int32.t.

Parameter pp_print_paragraph :
  Tezos_protocol_environment_alpha__Environment.Format.formatter -> string ->
  unit.

Parameter take : forall {a : Set}, Z -> list a -> option (list a * list a).

Parameter remove_prefix : string -> string -> option string.

Parameter remove_elem_from_list : forall {a : Set}, Z -> list a -> list a.

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

(* 32 *)
let nonce_hash = "\069\220\169" (* nce(53) *)

include Blake2B.Make
          (Base58)
          (struct
            let name = "cycle_nonce"

            let title = "A nonce hash"

            let b58check_prefix = nonce_hash

            let size = None
          end)

let () = Base58.check_encoded_prefix b58check_encoding "nce" 53

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Definition nonce_hash : string := "Eܩ" % string.

(* ❌ Cannot include this kind of module expression *)
include

(* ❌ Top-level evaluations are considered as an error as sources of side-effects *)
Compute Base58.check_encoded_prefix b58check_encoding "nce" % string 53.

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

type t = Seed_repr.nonce

type nonce = t

let encoding = Seed_repr.nonce_encoding

type error +=
  | Too_late_revelation
  | Too_early_revelation
  | Previously_revealed_nonce
  | Unexpected_nonce

let () =
  register_error_kind
    `Branch
    ~id:"nonce.too_late_revelation"
    ~title:"Too late nonce revelation"
    ~description:"Nonce revelation happens too late"
    ~pp:(fun ppf () ->
      Format.fprintf ppf "This nonce cannot be revealed anymore.")
    Data_encoding.unit
    (function Too_late_revelation -> Some () | _ -> None)
    (fun () -> Too_late_revelation) ;
  register_error_kind
    `Temporary
    ~id:"nonce.too_early_revelation"
    ~title:"Too early nonce revelation"
    ~description:"Nonce revelation happens before cycle end"
    ~pp:(fun ppf () ->
      Format.fprintf ppf "This nonce should not yet be revealed")
    Data_encoding.unit
    (function Too_early_revelation -> Some () | _ -> None)
    (fun () -> Too_early_revelation) ;
  register_error_kind
    `Branch
    ~id:"nonce.previously_revealed"
    ~title:"Previously revealed nonce"
    ~description:"Duplicated revelation for a nonce."
    ~pp:(fun ppf () -> Format.fprintf ppf "This nonce was previously revealed")
    Data_encoding.unit
    (function Previously_revealed_nonce -> Some () | _ -> None)
    (fun () -> Previously_revealed_nonce) ;
  register_error_kind
    `Branch
    ~id:"nonce.unexpected"
    ~title:"Unexpected nonce"
    ~description:
      "The provided nonce is inconsistent with the committed nonce hash."
    ~pp:(fun ppf () ->
      Format.fprintf
        ppf
        "This nonce revelation is invalid (inconsistent with the committed \
         hash)")
    Data_encoding.unit
    (function Unexpected_nonce -> Some () | _ -> None)
    (fun () -> Unexpected_nonce)

(* checks that the level of a revelation is not too early or too late wrt to the
   current context and that a nonce has not been already revealed for that level *)
let get_unrevealed ctxt level =
  let cur_level = Level_storage.current ctxt in
  match Cycle_repr.pred cur_level.cycle with
  | None ->
      fail Too_early_revelation (* no revelations during cycle 0 *)
  | Some revealed_cycle -> (
      if Cycle_repr.(revealed_cycle < level.Level_repr.cycle) then
        fail Too_early_revelation
      else if Cycle_repr.(level.Level_repr.cycle < revealed_cycle) then
        fail Too_late_revelation
      else
        Storage.Seed.Nonce.get ctxt level
        >>=? function
        | Revealed _ ->
            fail Previously_revealed_nonce
        | Unrevealed status ->
            return status )

let record_hash ctxt unrevealed =
  let level = Level_storage.current ctxt in
  Storage.Seed.Nonce.init ctxt level (Unrevealed unrevealed)

let reveal ctxt level nonce =
  get_unrevealed ctxt level
  >>=? fun unrevealed ->
  fail_unless
    (Seed_repr.check_hash nonce unrevealed.nonce_hash)
    Unexpected_nonce
  >>=? fun () ->
  Storage.Seed.Nonce.set ctxt level (Revealed nonce)
  >>=? fun ctxt -> return ctxt

type unrevealed = Storage.Seed.unrevealed_nonce = {
  nonce_hash : Nonce_hash.t;
  delegate : Signature.Public_key_hash.t;
  rewards : Tez_repr.t;
  fees : Tez_repr.t;
}

type status = Storage.Seed.nonce_status =
  | Unrevealed of unrevealed
  | Revealed of Seed_repr.nonce

let get = Storage.Seed.Nonce.get

let of_bytes = Seed_repr.make_nonce

let hash = Seed_repr.hash

let check_hash = Seed_repr.check_hash

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Definition t := Tezos_raw_protocol_alpha.Seed_repr.nonce.

Definition nonce := t.

Definition encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.t
    Tezos_raw_protocol_alpha.Seed_repr.nonce := Seed_repr.nonce_encoding.

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Top-level evaluations are considered as an error as sources of side-effects *)
Compute
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "nonce.too_late_revelation" % string
      "Too late nonce revelation" % string
      "Nonce revelation happens too late" % string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let 'tt := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "This nonce cannot be revealed anymore." % string
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
                "This nonce cannot be revealed anymore." % string)))
      Data_encoding.__unit_value
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Too_late_revelation
          => Some tt
        | _ => None
        end)
      (fun function_parameter =>
        let 'tt := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Too_late_revelation)
    in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "nonce.too_early_revelation" % string
      "Too early nonce revelation" % string
      "Nonce revelation happens before cycle end" % string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let 'tt := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "This nonce should not yet be revealed" % string
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
                "This nonce should not yet be revealed" % string)))
      Data_encoding.__unit_value
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Too_early_revelation
          => Some tt
        | _ => None
        end)
      (fun function_parameter =>
        let 'tt := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Too_early_revelation)
    in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "nonce.previously_revealed" % string
      "Previously revealed nonce" % string
      "Duplicated revelation for a nonce." % string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let 'tt := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "This nonce was previously revealed" % string
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
                "This nonce was previously revealed" % string)))
      Data_encoding.__unit_value
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Previously_revealed_nonce
          => Some tt
        | _ => None
        end)
      (fun function_parameter =>
        let 'tt := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Previously_revealed_nonce)
    in
  register_error_kind
    (* ❌ Variants not supported *)
    variant "nonce.unexpected" % string "Unexpected nonce" % string
    "The provided nonce is inconsistent with the committed nonce hash." % string
    (Some
      (fun ppf =>
        fun function_parameter =>
          let 'tt := function_parameter in
          Format.fprintf ppf
            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                "This nonce revelation is invalid (inconsistent with the committed hash)"
                  % string
                Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
              "This nonce revelation is invalid (inconsistent with the committed hash)"
                % string))) Data_encoding.__unit_value
    (fun function_parameter =>
      match function_parameter with
      |
        Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_nonce
        => Some tt
      | _ => None
      end)
    (fun function_parameter =>
      let 'tt := function_parameter in
      Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_nonce).

Definition get_unrevealed
  (ctxt : Tezos_raw_protocol_alpha.Raw_context.t)
  (level : Tezos_raw_protocol_alpha.Level_repr.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha__Storage.Seed.unrevealed_nonce) :=
  let cur_level := Level_storage.current ctxt in
  match Cycle_repr.pred (Tezos_raw_protocol_alpha.Level_repr.t.cycle cur_level)
    with
  | None =>
    fail
      Tezos_protocol_environment_alpha__Environment.Error_monad.Too_early_revelation
  | Some revealed_cycle =>
    if op_lt revealed_cycle (Tezos_raw_protocol_alpha.Level_repr.t.cycle level)
      then
      fail
        Tezos_protocol_environment_alpha__Environment.Error_monad.Too_early_revelation
    else
      if
        op_lt (Tezos_raw_protocol_alpha.Level_repr.t.cycle level) revealed_cycle
        then
        fail
          Tezos_protocol_environment_alpha__Environment.Error_monad.Too_late_revelation
      else
        op_gtgteqquestion (Storage.Seed.Nonce.get ctxt level)
          (fun function_parameter =>
            match function_parameter with
            | Tezos_raw_protocol_alpha__Storage.Seed.Revealed _ =>
              fail
                Tezos_protocol_environment_alpha__Environment.Error_monad.Previously_revealed_nonce
            | Tezos_raw_protocol_alpha__Storage.Seed.Unrevealed status =>
              __return status
            end)
  end.

Definition record_hash
  (ctxt : Tezos_raw_protocol_alpha.Raw_context.t)
  (unrevealed : Tezos_raw_protocol_alpha__Storage.Seed.unrevealed_nonce)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  let level := Level_storage.current ctxt in
  Storage.Seed.Nonce.init ctxt level
    (Tezos_raw_protocol_alpha__Storage.Seed.Unrevealed unrevealed).

Definition reveal
  (ctxt : Tezos_raw_protocol_alpha.Raw_context.t)
  (level : Tezos_raw_protocol_alpha.Level_repr.t)
  (nonce : Tezos_raw_protocol_alpha.Seed_repr.nonce)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  op_gtgteqquestion (get_unrevealed ctxt level)
    (fun unrevealed =>
      op_gtgteqquestion
        (fail_unless
          (Seed_repr.check_hash nonce
            (Tezos_raw_protocol_alpha__Storage.Seed.unrevealed_nonce.nonce_hash
              unrevealed))
          Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_nonce)
        (fun function_parameter =>
          let 'tt := function_parameter in
          op_gtgteqquestion
            (Storage.Seed.Nonce.set ctxt level
              (Tezos_raw_protocol_alpha__Storage.Seed.Revealed nonce))
            (fun ctxt => __return ctxt))).

Module unrevealed.
  Record record := {
    nonce_hash : Tezos_raw_protocol_alpha.Nonce_hash.t;
    delegate :
      Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t;
    rewards : Tezos_raw_protocol_alpha.Tez_repr.t;
    fees : Tezos_raw_protocol_alpha.Tez_repr.t }.
End unrevealed.
Definition unrevealed := unrevealed.record.

Inductive status : Set :=
| Unrevealed : unrevealed -> status
| Revealed : Tezos_raw_protocol_alpha.Seed_repr.nonce -> status.

Definition get
  : Tezos_raw_protocol_alpha.Storage.Seed.Nonce.context ->
  Tezos_raw_protocol_alpha.Level_repr.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha__Storage.Seed.nonce_status) :=
  Storage.Seed.Nonce.get.

Definition of_bytes
  : Tezos_protocol_environment_alpha__Environment.MBytes.t ->
  Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    Tezos_raw_protocol_alpha.Seed_repr.nonce := Seed_repr.make_nonce.

Definition __hash_value
  : Tezos_raw_protocol_alpha.Seed_repr.nonce ->
  Tezos_raw_protocol_alpha.Nonce_hash.t := Seed_repr.__hash_value.

Definition check_hash
  : Tezos_raw_protocol_alpha.Seed_repr.nonce ->
  Tezos_raw_protocol_alpha.Nonce_hash.t -> bool := Seed_repr.check_hash.

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

type error +=
  | Too_late_revelation
  | Too_early_revelation
  | Previously_revealed_nonce
  | Unexpected_nonce

type t = Seed_repr.nonce

type nonce = t

val encoding : nonce Data_encoding.t

type unrevealed = Storage.Seed.unrevealed_nonce = {
  nonce_hash : Nonce_hash.t;
  delegate : Signature.Public_key_hash.t;
  rewards : Tez_repr.t;
  fees : Tez_repr.t;
}

type status = Unrevealed of unrevealed | Revealed of Seed_repr.nonce

val get : Raw_context.t -> Level_repr.t -> status tzresult Lwt.t

val record_hash : Raw_context.t -> unrevealed -> Raw_context.t tzresult Lwt.t

val reveal :
  Raw_context.t -> Level_repr.t -> nonce -> Raw_context.t tzresult Lwt.t

val of_bytes : MBytes.t -> nonce tzresult

val hash : nonce -> Nonce_hash.t

val check_hash : nonce -> Nonce_hash.t -> bool

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

(* extensible_type Tezos_protocol_environment_alpha__Environment.Error_monad.error *)

Definition t := Tezos_raw_protocol_alpha.Seed_repr.nonce.

Definition nonce := t.

Parameter encoding :
  Tezos_protocol_environment_alpha__Environment.Data_encoding.t nonce.

Module unrevealed.
  Record record := {
    nonce_hash : Tezos_raw_protocol_alpha.Nonce_hash.t;
    delegate :
      Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t;
    rewards : Tezos_raw_protocol_alpha.Tez_repr.t;
    fees : Tezos_raw_protocol_alpha.Tez_repr.t }.
End unrevealed.
Definition unrevealed := unrevealed.record.

Inductive status : Set :=
| Unrevealed : unrevealed -> status
| Revealed : Tezos_raw_protocol_alpha.Seed_repr.nonce -> status.

Parameter get :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Level_repr.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult status).

Parameter record_hash :
  Tezos_raw_protocol_alpha.Raw_context.t -> unrevealed ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t).

Parameter reveal :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Level_repr.t -> nonce ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t).

Parameter of_bytes :
  Tezos_protocol_environment_alpha__Environment.MBytes.t ->
  Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult nonce.

Parameter __hash_value : nonce -> Tezos_raw_protocol_alpha.Nonce_hash.t.

Parameter check_hash : nonce -> Tezos_raw_protocol_alpha.Nonce_hash.t -> bool.

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

(* Tezos Protocol Implementation - Low level Repr. of Operations *)

module Kind = struct
  type seed_nonce_revelation = Seed_nonce_revelation_kind

  type double_endorsement_evidence = Double_endorsement_evidence_kind

  type double_baking_evidence = Double_baking_evidence_kind

  type activate_account = Activate_account_kind

  type endorsement = Endorsement_kind

  type proposals = Proposals_kind

  type ballot = Ballot_kind

  type reveal = Reveal_kind

  type transaction = Transaction_kind

  type origination = Origination_kind

  type delegation = Delegation_kind

  type 'a manager =
    | Reveal_manager_kind : reveal manager
    | Transaction_manager_kind : transaction manager
    | Origination_manager_kind : origination manager
    | Delegation_manager_kind : delegation manager
end

type raw = Operation.t = {shell : Operation.shell_header; proto : MBytes.t}

let raw_encoding = Operation.encoding

type 'kind operation = {
  shell : Operation.shell_header;
  protocol_data : 'kind protocol_data;
}

and 'kind protocol_data = {
  contents : 'kind contents_list;
  signature : Signature.t option;
}

and _ contents_list =
  | Single : 'kind contents -> 'kind contents_list
  | Cons :
      'kind Kind.manager contents * 'rest Kind.manager contents_list
      -> ('kind * 'rest) Kind.manager contents_list

and _ contents =
  | Endorsement : {level : Raw_level_repr.t} -> Kind.endorsement contents
  | Seed_nonce_revelation : {
      level : Raw_level_repr.t;
      nonce : Seed_repr.nonce;
    }
      -> Kind.seed_nonce_revelation contents
  | Double_endorsement_evidence : {
      op1 : Kind.endorsement operation;
      op2 : Kind.endorsement operation;
    }
      -> Kind.double_endorsement_evidence contents
  | Double_baking_evidence : {
      bh1 : Block_header_repr.t;
      bh2 : Block_header_repr.t;
    }
      -> Kind.double_baking_evidence contents
  | Activate_account : {
      id : Ed25519.Public_key_hash.t;
      activation_code : Blinded_public_key_hash.activation_code;
    }
      -> Kind.activate_account contents
  | Proposals : {
      source : Signature.Public_key_hash.t;
      period : Voting_period_repr.t;
      proposals : Protocol_hash.t list;
    }
      -> Kind.proposals contents
  | Ballot : {
      source : Signature.Public_key_hash.t;
      period : Voting_period_repr.t;
      proposal : Protocol_hash.t;
      ballot : Vote_repr.ballot;
    }
      -> Kind.ballot contents
  | Manager_operation : {
      source : Signature.public_key_hash;
      fee : Tez_repr.tez;
      counter : counter;
      operation : 'kind manager_operation;
      gas_limit : Z.t;
      storage_limit : Z.t;
    }
      -> 'kind Kind.manager contents

and _ manager_operation =
  | Reveal : Signature.Public_key.t -> Kind.reveal manager_operation
  | Transaction : {
      amount : Tez_repr.tez;
      parameters : Script_repr.lazy_expr;
      entrypoint : string;
      destination : Contract_repr.contract;
    }
      -> Kind.transaction manager_operation
  | Origination : {
      delegate : Signature.Public_key_hash.t option;
      script : Script_repr.t;
      credit : Tez_repr.tez;
      preorigination : Contract_repr.t option;
    }
      -> Kind.origination manager_operation
  | Delegation :
      Signature.Public_key_hash.t option
      -> Kind.delegation manager_operation

and counter = Z.t

let manager_kind : type kind. kind manager_operation -> kind Kind.manager =
  function
  | Reveal _ ->
      Kind.Reveal_manager_kind
  | Transaction _ ->
      Kind.Transaction_manager_kind
  | Origination _ ->
      Kind.Origination_manager_kind
  | Delegation _ ->
      Kind.Delegation_manager_kind

type 'kind internal_operation = {
  source : Contract_repr.contract;
  operation : 'kind manager_operation;
  nonce : int;
}

type packed_manager_operation =
  | Manager : 'kind manager_operation -> packed_manager_operation

type packed_contents = Contents : 'kind contents -> packed_contents

type packed_contents_list =
  | Contents_list : 'kind contents_list -> packed_contents_list

type packed_protocol_data =
  | Operation_data : 'kind protocol_data -> packed_protocol_data

type packed_operation = {
  shell : Operation.shell_header;
  protocol_data : packed_protocol_data;
}

let pack ({shell; protocol_data} : _ operation) : packed_operation =
  {shell; protocol_data = Operation_data protocol_data}

type packed_internal_operation =
  | Internal_operation : 'kind internal_operation -> packed_internal_operation

let rec to_list = function
  | Contents_list (Single o) ->
      [Contents o]
  | Contents_list (Cons (o, os)) ->
      Contents o :: to_list (Contents_list os)

let rec of_list = function
  | [] ->
      assert false
  | [Contents o] ->
      Contents_list (Single o)
  | Contents o :: os -> (
      let (Contents_list os) = of_list os in
      match (o, os) with
      | (Manager_operation _, Single (Manager_operation _)) ->
          Contents_list (Cons (o, os))
      | (Manager_operation _, Cons _) ->
          Contents_list (Cons (o, os))
      | _ ->
          Pervasives.failwith
            "Operation list of length > 1 should only contains manager \
             operations." )

module Encoding = struct
  open Data_encoding

  let case tag name args proj inj =
    let open Data_encoding in
    case
      tag
      ~title:(String.capitalize_ascii name)
      (merge_objs (obj1 (req "kind" (constant name))) args)
      (fun x -> match proj x with None -> None | Some x -> Some ((), x))
      (fun ((), x) -> inj x)

  module Manager_operations = struct
    type 'kind case =
      | MCase : {
          tag : int;
          name : string;
          encoding : 'a Data_encoding.t;
          select : packed_manager_operation -> 'kind manager_operation option;
          proj : 'kind manager_operation -> 'a;
          inj : 'a -> 'kind manager_operation;
        }
          -> 'kind case

    let reveal_case =
      MCase
        {
          tag = 0;
          name = "reveal";
          encoding = obj1 (req "public_key" Signature.Public_key.encoding);
          select = (function Manager (Reveal _ as op) -> Some op | _ -> None);
          proj = (function Reveal pkh -> pkh);
          inj = (fun pkh -> Reveal pkh);
        }

    let entrypoint_encoding =
      def
        ~title:"entrypoint"
        ~description:"Named entrypoint to a Michelson smart contract"
        "entrypoint"
      @@
      let builtin_case tag name =
        Data_encoding.case
          (Tag tag)
          ~title:name
          (constant name)
          (fun n -> if Compare.String.(n = name) then Some () else None)
          (fun () -> name)
      in
      union
        [ builtin_case 0 "default";
          builtin_case 1 "root";
          builtin_case 2 "do";
          builtin_case 3 "set_delegate";
          builtin_case 4 "remove_delegate";
          Data_encoding.case
            (Tag 255)
            ~title:"named"
            (Bounded.string 31)
            (fun s -> Some s)
            (fun s -> s) ]

    let transaction_case =
      MCase
        {
          tag = 1;
          name = "transaction";
          encoding =
            obj3
              (req "amount" Tez_repr.encoding)
              (req "destination" Contract_repr.encoding)
              (opt
                 "parameters"
                 (obj2
                    (req "entrypoint" entrypoint_encoding)
                    (req "value" Script_repr.lazy_expr_encoding)));
          select =
            (function Manager (Transaction _ as op) -> Some op | _ -> None);
          proj =
            (function
            | Transaction {amount; destination; parameters; entrypoint} ->
                let parameters =
                  if
                    Script_repr.is_unit_parameter parameters
                    && Compare.String.(entrypoint = "default")
                  then None
                  else Some (entrypoint, parameters)
                in
                (amount, destination, parameters));
          inj =
            (fun (amount, destination, parameters) ->
              let (entrypoint, parameters) =
                match parameters with
                | None ->
                    ("default", Script_repr.unit_parameter)
                | Some (entrypoint, value) ->
                    (entrypoint, value)
              in
              Transaction {amount; destination; parameters; entrypoint});
        }

    let origination_case =
      MCase
        {
          tag = 2;
          name = "origination";
          encoding =
            obj3
              (req "balance" Tez_repr.encoding)
              (opt "delegate" Signature.Public_key_hash.encoding)
              (req "script" Script_repr.encoding);
          select =
            (function Manager (Origination _ as op) -> Some op | _ -> None);
          proj =
            (function
            | Origination
                { credit;
                  delegate;
                  script;
                  preorigination =
                    _
                    (* the hash is only used internally
                               when originating from smart
                               contracts, don't serialize it *)
                } ->
                (credit, delegate, script));
          inj =
            (fun (credit, delegate, script) ->
              Origination {credit; delegate; script; preorigination = None});
        }

    let delegation_case =
      MCase
        {
          tag = 3;
          name = "delegation";
          encoding = obj1 (opt "delegate" Signature.Public_key_hash.encoding);
          select =
            (function Manager (Delegation _ as op) -> Some op | _ -> None);
          proj = (function Delegation key -> key);
          inj = (fun key -> Delegation key);
        }

    let encoding =
      let make (MCase {tag; name; encoding; select; proj; inj}) =
        case
          (Tag tag)
          name
          encoding
          (fun o ->
            match select o with None -> None | Some o -> Some (proj o))
          (fun x -> Manager (inj x))
      in
      union
        ~tag_size:`Uint8
        [ make reveal_case;
          make transaction_case;
          make origination_case;
          make delegation_case ]
  end

  type 'b case =
    | Case : {
        tag : int;
        name : string;
        encoding : 'a Data_encoding.t;
        select : packed_contents -> 'b contents option;
        proj : 'b contents -> 'a;
        inj : 'a -> 'b contents;
      }
        -> 'b case

  let endorsement_encoding = obj1 (req "level" Raw_level_repr.encoding)

  let endorsement_case =
    Case
      {
        tag = 0;
        name = "endorsement";
        encoding = endorsement_encoding;
        select =
          (function Contents (Endorsement _ as op) -> Some op | _ -> None);
        proj = (fun (Endorsement {level}) -> level);
        inj = (fun level -> Endorsement {level});
      }

  let endorsement_encoding =
    let make (Case {tag; name; encoding; select = _; proj; inj}) =
      case (Tag tag) name encoding (fun o -> Some (proj o)) (fun x -> inj x)
    in
    let to_list : Kind.endorsement contents_list -> _ = function
      | Single o ->
          o
    in
    let of_list : Kind.endorsement contents -> _ = function o -> Single o in
    def "inlined.endorsement"
    @@ conv
         (fun ({shell; protocol_data = {contents; signature}} : _ operation) ->
           (shell, (contents, signature)))
         (fun (shell, (contents, signature)) ->
           ({shell; protocol_data = {contents; signature}} : _ operation))
         (merge_objs
            Operation.shell_header_encoding
            (obj2
               (req
                  "operations"
                  ( conv to_list of_list
                  @@ def "inlined.endorsement.contents"
                  @@ union [make endorsement_case] ))
               (varopt "signature" Signature.encoding)))

  let seed_nonce_revelation_case =
    Case
      {
        tag = 1;
        name = "seed_nonce_revelation";
        encoding =
          obj2
            (req "level" Raw_level_repr.encoding)
            (req "nonce" Seed_repr.nonce_encoding);
        select =
          (function
          | Contents (Seed_nonce_revelation _ as op) -> Some op | _ -> None);
        proj = (fun (Seed_nonce_revelation {level; nonce}) -> (level, nonce));
        inj = (fun (level, nonce) -> Seed_nonce_revelation {level; nonce});
      }

  let double_endorsement_evidence_case : Kind.double_endorsement_evidence case
      =
    Case
      {
        tag = 2;
        name = "double_endorsement_evidence";
        encoding =
          obj2
            (req "op1" (dynamic_size endorsement_encoding))
            (req "op2" (dynamic_size endorsement_encoding));
        select =
          (function
          | Contents (Double_endorsement_evidence _ as op) ->
              Some op
          | _ ->
              None);
        proj = (fun (Double_endorsement_evidence {op1; op2}) -> (op1, op2));
        inj = (fun (op1, op2) -> Double_endorsement_evidence {op1; op2});
      }

  let double_baking_evidence_case =
    Case
      {
        tag = 3;
        name = "double_baking_evidence";
        encoding =
          obj2
            (req "bh1" (dynamic_size Block_header_repr.encoding))
            (req "bh2" (dynamic_size Block_header_repr.encoding));
        select =
          (function
          | Contents (Double_baking_evidence _ as op) -> Some op | _ -> None);
        proj = (fun (Double_baking_evidence {bh1; bh2}) -> (bh1, bh2));
        inj = (fun (bh1, bh2) -> Double_baking_evidence {bh1; bh2});
      }

  let activate_account_case =
    Case
      {
        tag = 4;
        name = "activate_account";
        encoding =
          obj2
            (req "pkh" Ed25519.Public_key_hash.encoding)
            (req "secret" Blinded_public_key_hash.activation_code_encoding);
        select =
          (function
          | Contents (Activate_account _ as op) -> Some op | _ -> None);
        proj =
          (fun (Activate_account {id; activation_code}) ->
            (id, activation_code));
        inj =
          (fun (id, activation_code) -> Activate_account {id; activation_code});
      }

  let proposals_case =
    Case
      {
        tag = 5;
        name = "proposals";
        encoding =
          obj3
            (req "source" Signature.Public_key_hash.encoding)
            (req "period" Voting_period_repr.encoding)
            (req "proposals" (list Protocol_hash.encoding));
        select =
          (function Contents (Proposals _ as op) -> Some op | _ -> None);
        proj =
          (fun (Proposals {source; period; proposals}) ->
            (source, period, proposals));
        inj =
          (fun (source, period, proposals) ->
            Proposals {source; period; proposals});
      }

  let ballot_case =
    Case
      {
        tag = 6;
        name = "ballot";
        encoding =
          obj4
            (req "source" Signature.Public_key_hash.encoding)
            (req "period" Voting_period_repr.encoding)
            (req "proposal" Protocol_hash.encoding)
            (req "ballot" Vote_repr.ballot_encoding);
        select = (function Contents (Ballot _ as op) -> Some op | _ -> None);
        proj =
          (function
          | Ballot {source; period; proposal; ballot} ->
              (source, period, proposal, ballot));
        inj =
          (fun (source, period, proposal, ballot) ->
            Ballot {source; period; proposal; ballot});
      }

  let manager_encoding =
    obj5
      (req "source" Signature.Public_key_hash.encoding)
      (req "fee" Tez_repr.encoding)
      (req "counter" (check_size 10 n))
      (req "gas_limit" (check_size 10 n))
      (req "storage_limit" (check_size 10 n))

  let extract (type kind)
      (Manager_operation
         {source; fee; counter; gas_limit; storage_limit; operation = _} :
        kind Kind.manager contents) =
    (source, fee, counter, gas_limit, storage_limit)

  let rebuild (source, fee, counter, gas_limit, storage_limit) operation =
    Manager_operation
      {source; fee; counter; gas_limit; storage_limit; operation}

  let make_manager_case tag (type kind)
      (Manager_operations.MCase mcase : kind Manager_operations.case) =
    Case
      {
        tag;
        name = mcase.name;
        encoding = merge_objs manager_encoding mcase.encoding;
        select =
          (function
          | Contents (Manager_operation ({operation; _} as op)) -> (
            match mcase.select (Manager operation) with
            | None ->
                None
            | Some operation ->
                Some (Manager_operation {op with operation}) )
          | _ ->
              None);
        proj =
          (function
          | Manager_operation {operation; _} as op ->
              (extract op, mcase.proj operation));
        inj = (fun (op, contents) -> rebuild op (mcase.inj contents));
      }

  let reveal_case = make_manager_case 107 Manager_operations.reveal_case

  let transaction_case =
    make_manager_case 108 Manager_operations.transaction_case

  let origination_case =
    make_manager_case 109 Manager_operations.origination_case

  let delegation_case =
    make_manager_case 110 Manager_operations.delegation_case

  let contents_encoding =
    let make (Case {tag; name; encoding; select; proj; inj}) =
      case
        (Tag tag)
        name
        encoding
        (fun o -> match select o with None -> None | Some o -> Some (proj o))
        (fun x -> Contents (inj x))
    in
    def "operation.alpha.contents"
    @@ union
         [ make endorsement_case;
           make seed_nonce_revelation_case;
           make double_endorsement_evidence_case;
           make double_baking_evidence_case;
           make activate_account_case;
           make proposals_case;
           make ballot_case;
           make reveal_case;
           make transaction_case;
           make origination_case;
           make delegation_case ]

  let contents_list_encoding =
    conv to_list of_list (Variable.list contents_encoding)

  let optional_signature_encoding =
    conv
      (function Some s -> s | None -> Signature.zero)
      (fun s -> if Signature.equal s Signature.zero then None else Some s)
      Signature.encoding

  let protocol_data_encoding =
    def "operation.alpha.contents_and_signature"
    @@ conv
         (fun (Operation_data {contents; signature}) ->
           (Contents_list contents, signature))
         (fun (Contents_list contents, signature) ->
           Operation_data {contents; signature})
         (obj2
            (req "contents" contents_list_encoding)
            (req "signature" optional_signature_encoding))

  let operation_encoding =
    conv
      (fun {shell; protocol_data} -> (shell, protocol_data))
      (fun (shell, protocol_data) -> {shell; protocol_data})
      (merge_objs Operation.shell_header_encoding protocol_data_encoding)

  let unsigned_operation_encoding =
    def "operation.alpha.unsigned_operation"
    @@ merge_objs
         Operation.shell_header_encoding
         (obj1 (req "contents" contents_list_encoding))

  let internal_operation_encoding =
    def "operation.alpha.internal_operation"
    @@ conv
         (fun (Internal_operation {source; operation; nonce}) ->
           ((source, nonce), Manager operation))
         (fun ((source, nonce), Manager operation) ->
           Internal_operation {source; operation; nonce})
         (merge_objs
            (obj2 (req "source" Contract_repr.encoding) (req "nonce" uint16))
            Manager_operations.encoding)
end

let encoding = Encoding.operation_encoding

let contents_encoding = Encoding.contents_encoding

let contents_list_encoding = Encoding.contents_list_encoding

let protocol_data_encoding = Encoding.protocol_data_encoding

let unsigned_operation_encoding = Encoding.unsigned_operation_encoding

let internal_operation_encoding = Encoding.internal_operation_encoding

let raw ({shell; protocol_data} : _ operation) =
  let proto =
    Data_encoding.Binary.to_bytes_exn
      protocol_data_encoding
      (Operation_data protocol_data)
  in
  {Operation.shell; proto}

let acceptable_passes (op : packed_operation) =
  let (Operation_data protocol_data) = op.protocol_data in
  match protocol_data.contents with
  | Single (Endorsement _) ->
      [0]
  | Single (Proposals _) ->
      [1]
  | Single (Ballot _) ->
      [1]
  | Single (Seed_nonce_revelation _) ->
      [2]
  | Single (Double_endorsement_evidence _) ->
      [2]
  | Single (Double_baking_evidence _) ->
      [2]
  | Single (Activate_account _) ->
      [2]
  | Single (Manager_operation _) ->
      [3]
  | Cons _ ->
      [3]

type error += Invalid_signature (* `Permanent *)

type error += Missing_signature (* `Permanent *)

let () =
  register_error_kind
    `Permanent
    ~id:"operation.invalid_signature"
    ~title:"Invalid operation signature"
    ~description:
      "The operation signature is ill-formed or has been made with the wrong \
       public key"
    ~pp:(fun ppf () -> Format.fprintf ppf "The operation signature is invalid")
    Data_encoding.unit
    (function Invalid_signature -> Some () | _ -> None)
    (fun () -> Invalid_signature) ;
  register_error_kind
    `Permanent
    ~id:"operation.missing_signature"
    ~title:"Missing operation signature"
    ~description:
      "The operation is of a kind that must be signed, but the signature is \
       missing"
    ~pp:(fun ppf () -> Format.fprintf ppf "The operation requires a signature")
    Data_encoding.unit
    (function Missing_signature -> Some () | _ -> None)
    (fun () -> Missing_signature)

let check_signature_sync (type kind) key chain_id
    ({shell; protocol_data} : kind operation) =
  let check ~watermark contents signature =
    let unsigned_operation =
      Data_encoding.Binary.to_bytes_exn
        unsigned_operation_encoding
        (shell, contents)
    in
    if Signature.check ~watermark key signature unsigned_operation then Ok ()
    else error Invalid_signature
  in
  match (protocol_data.contents, protocol_data.signature) with
  | (Single _, None) ->
      error Missing_signature
  | (Cons _, None) ->
      error Missing_signature
  | ((Single (Endorsement _) as contents), Some signature) ->
      check
        ~watermark:(Endorsement chain_id)
        (Contents_list contents)
        signature
  | ((Single _ as contents), Some signature) ->
      check ~watermark:Generic_operation (Contents_list contents) signature
  | ((Cons _ as contents), Some signature) ->
      check ~watermark:Generic_operation (Contents_list contents) signature

let check_signature pk chain_id op =
  Lwt.return (check_signature_sync pk chain_id op)

let hash_raw = Operation.hash

let hash (o : _ operation) =
  let proto =
    Data_encoding.Binary.to_bytes_exn
      protocol_data_encoding
      (Operation_data o.protocol_data)
  in
  Operation.hash {shell = o.shell; proto}

let hash_packed (o : packed_operation) =
  let proto =
    Data_encoding.Binary.to_bytes_exn protocol_data_encoding o.protocol_data
  in
  Operation.hash {shell = o.shell; proto}

type ('a, 'b) eq = Eq : ('a, 'a) eq

let equal_manager_operation_kind :
    type a b. a manager_operation -> b manager_operation -> (a, b) eq option =
 fun op1 op2 ->
  match (op1, op2) with
  | (Reveal _, Reveal _) ->
      Some Eq
  | (Reveal _, _) ->
      None
  | (Transaction _, Transaction _) ->
      Some Eq
  | (Transaction _, _) ->
      None
  | (Origination _, Origination _) ->
      Some Eq
  | (Origination _, _) ->
      None
  | (Delegation _, Delegation _) ->
      Some Eq
  | (Delegation _, _) ->
      None

let equal_contents_kind :
    type a b. a contents -> b contents -> (a, b) eq option =
 fun op1 op2 ->
  match (op1, op2) with
  | (Endorsement _, Endorsement _) ->
      Some Eq
  | (Endorsement _, _) ->
      None
  | (Seed_nonce_revelation _, Seed_nonce_revelation _) ->
      Some Eq
  | (Seed_nonce_revelation _, _) ->
      None
  | (Double_endorsement_evidence _, Double_endorsement_evidence _) ->
      Some Eq
  | (Double_endorsement_evidence _, _) ->
      None
  | (Double_baking_evidence _, Double_baking_evidence _) ->
      Some Eq
  | (Double_baking_evidence _, _) ->
      None
  | (Activate_account _, Activate_account _) ->
      Some Eq
  | (Activate_account _, _) ->
      None
  | (Proposals _, Proposals _) ->
      Some Eq
  | (Proposals _, _) ->
      None
  | (Ballot _, Ballot _) ->
      Some Eq
  | (Ballot _, _) ->
      None
  | (Manager_operation op1, Manager_operation op2) -> (
    match equal_manager_operation_kind op1.operation op2.operation with
    | None ->
        None
    | Some Eq ->
        Some Eq )
  | (Manager_operation _, _) ->
      None

let rec equal_contents_kind_list :
    type a b. a contents_list -> b contents_list -> (a, b) eq option =
 fun op1 op2 ->
  match (op1, op2) with
  | (Single op1, Single op2) ->
      equal_contents_kind op1 op2
  | (Single _, Cons _) ->
      None
  | (Cons _, Single _) ->
      None
  | (Cons (op1, ops1), Cons (op2, ops2)) -> (
    match equal_contents_kind op1 op2 with
    | None ->
        None
    | Some Eq -> (
      match equal_contents_kind_list ops1 ops2 with
      | None ->
          None
      | Some Eq ->
          Some Eq ) )

let equal : type a b. a operation -> b operation -> (a, b) eq option =
 fun op1 op2 ->
  if not (Operation_hash.equal (hash op1) (hash op2)) then None
  else
    equal_contents_kind_list
      op1.protocol_data.contents
      op2.protocol_data.contents

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Module Kind.
  Inductive seed_nonce_revelation : Set :=
  | Seed_nonce_revelation_kind : seed_nonce_revelation.
  
  Inductive double_endorsement_evidence : Set :=
  | Double_endorsement_evidence_kind : double_endorsement_evidence.
  
  Inductive double_baking_evidence : Set :=
  | Double_baking_evidence_kind : double_baking_evidence.
  
  Inductive activate_account : Set :=
  | Activate_account_kind : activate_account.
  
  Inductive endorsement : Set :=
  | Endorsement_kind : endorsement.
  
  Inductive proposals : Set :=
  | Proposals_kind : proposals.
  
  Inductive ballot : Set :=
  | Ballot_kind : ballot.
  
  Inductive reveal : Set :=
  | Reveal_kind : reveal.
  
  Inductive transaction : Set :=
  | Transaction_kind : transaction.
  
  Inductive origination : Set :=
  | Origination_kind : origination.
  
  Inductive delegation : Set :=
  | Delegation_kind : delegation.
  
  Reserved Notation "'manager".
  
  Inductive manager_gadt : Set :=
  | Reveal_manager_kind : manager_gadt
  | Transaction_manager_kind : manager_gadt
  | Origination_manager_kind : manager_gadt
  | Delegation_manager_kind : manager_gadt
  
  where "'manager" := (fun (a : Set) => manager_gadt).
  
  Definition manager := 'manager.
End Kind.

Module raw.
  Record record := {
    shell : Tezos_protocol_environment_alpha__Environment.Operation.shell_header;
    proto : Tezos_protocol_environment_alpha__Environment.MBytes.t }.
End raw.
Definition raw := raw.record.

Definition raw_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.t
    Tezos_protocol_environment_alpha__Environment.Operation.t :=
  Operation.encoding.

Reserved Notation "'operation".
Reserved Notation "'protocol_data".
Reserved Notation "'contents_list".
Reserved Notation "'contents".
Reserved Notation "'manager_operation".
Reserved Notation "'counter".

Module protocol_data_skeleton.
  Record record {contents signature : Set} := {
    contents : contents;
    signature : signature }.
  Arguments record : clear implicits.
End protocol_data_skeleton.
Definition protocol_data_skeleton := protocol_data_skeleton.record.

Module operation_skeleton.
  Record record {shell protocol_data : Set} := {
    shell : shell;
    protocol_data : protocol_data }.
  Arguments record : clear implicits.
End operation_skeleton.
Definition operation_skeleton := operation_skeleton.record.

Inductive contents_list_gadt : Set :=
| Single : forall {kind : Set}, 'contents kind -> contents_list_gadt
| Cons : forall {kind : Set},
  'contents (Kind.manager kind) -> contents_list_gadt -> contents_list_gadt

with contents_gadt : Set :=
| Endorsement : Tezos_raw_protocol_alpha.Raw_level_repr.t -> contents_gadt
| Seed_nonce_revelation :
  Tezos_raw_protocol_alpha.Raw_level_repr.t ->
  Tezos_raw_protocol_alpha.Seed_repr.nonce -> contents_gadt
| Double_endorsement_evidence :
  'operation Kind.endorsement -> 'operation Kind.endorsement -> contents_gadt
| Double_baking_evidence :
  Tezos_raw_protocol_alpha.Block_header_repr.t ->
  Tezos_raw_protocol_alpha.Block_header_repr.t -> contents_gadt
| Activate_account :
  Tezos_protocol_environment_alpha__Environment.Ed25519.Public_key_hash.t ->
  Tezos_raw_protocol_alpha.Blinded_public_key_hash.activation_code ->
  contents_gadt
| Proposals :
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Tezos_raw_protocol_alpha.Voting_period_repr.t ->
  list Tezos_protocol_environment_alpha__Environment.Protocol_hash.t ->
  contents_gadt
| Ballot :
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Tezos_raw_protocol_alpha.Voting_period_repr.t ->
  Tezos_protocol_environment_alpha__Environment.Protocol_hash.t ->
  Tezos_raw_protocol_alpha.Vote_repr.ballot -> contents_gadt
| Manager_operation : forall {kind : Set},
  Tezos_protocol_environment_alpha__Environment.Signature.public_key_hash ->
  Tezos_raw_protocol_alpha.Tez_repr.tez -> 'counter ->
  'manager_operation kind ->
  Tezos_protocol_environment_alpha__Environment.Z.t ->
  Tezos_protocol_environment_alpha__Environment.Z.t -> contents_gadt

with manager_operation_gadt : Set :=
| Reveal :
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t ->
  manager_operation_gadt
| Transaction :
  Tezos_raw_protocol_alpha.Tez_repr.tez ->
  Tezos_raw_protocol_alpha.Script_repr.lazy_expr -> string ->
  Tezos_raw_protocol_alpha.Contract_repr.contract -> manager_operation_gadt
| Origination :
  option
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Tezos_raw_protocol_alpha.Script_repr.t ->
  Tezos_raw_protocol_alpha.Tez_repr.tez ->
  option Tezos_raw_protocol_alpha.Contract_repr.t -> manager_operation_gadt
| Delegation :
  option
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  manager_operation_gadt

where "'operation" := (fun (kind : Set) =>
  operation_skeleton
    Tezos_protocol_environment_alpha__Environment.Operation.shell_header
    ('protocol_data kind))
and "'protocol_data" := (fun (kind : Set) =>
  protocol_data_skeleton ('contents_list kind)
    (option Tezos_protocol_environment_alpha__Environment.Signature.t))
and "'contents_list" := (fun (_ : Set) => contents_list_gadt)
and "'contents" := (fun (_ : Set) => contents_gadt)
and "'manager_operation" := (fun (_ : Set) => manager_operation_gadt)
and "'counter" := (Tezos_protocol_environment_alpha__Environment.Z.t).

Definition operation := 'operation.
Definition protocol_data := 'protocol_data.
Definition contents_list := 'contents_list.
Definition contents := 'contents.
Definition manager_operation := 'manager_operation.
Definition counter := 'counter.

Definition manager_kind {kind : Set}
  (function_parameter : manager_operation kind) : Kind.manager kind :=
  match function_parameter with
  | Reveal _ => Kind.Reveal_manager_kind
  | Transaction _ => Kind.Transaction_manager_kind
  | Origination _ => Kind.Origination_manager_kind
  | Delegation _ => Kind.Delegation_manager_kind
  end.

Module internal_operation.
  Record record {kind : Set} := {
    source : Tezos_raw_protocol_alpha.Contract_repr.contract;
    operation : manager_operation kind;
    nonce : Z }.
  Arguments record : clear implicits.
End internal_operation.
Definition internal_operation := internal_operation.record.

Reserved Notation "'packed_manager_operation".

Inductive packed_manager_operation_gadt : Set :=
| Manager : forall {kind : Set},
  manager_operation kind -> packed_manager_operation_gadt

where "'packed_manager_operation" := (packed_manager_operation_gadt).

Definition packed_manager_operation := 'packed_manager_operation.

Reserved Notation "'packed_contents".

Inductive packed_contents_gadt : Set :=
| Contents : forall {kind : Set}, contents kind -> packed_contents_gadt

where "'packed_contents" := (packed_contents_gadt).

Definition packed_contents := 'packed_contents.

Reserved Notation "'packed_contents_list".

Inductive packed_contents_list_gadt : Set :=
| Contents_list : forall {kind : Set},
  contents_list kind -> packed_contents_list_gadt

where "'packed_contents_list" := (packed_contents_list_gadt).

Definition packed_contents_list := 'packed_contents_list.

Reserved Notation "'packed_protocol_data".

Inductive packed_protocol_data_gadt : Set :=
| Operation_data : forall {kind : Set},
  protocol_data kind -> packed_protocol_data_gadt

where "'packed_protocol_data" := (packed_protocol_data_gadt).

Definition packed_protocol_data := 'packed_protocol_data.

Module packed_operation.
  Record record := {
    shell : Tezos_protocol_environment_alpha__Environment.Operation.shell_header;
    protocol_data : packed_protocol_data }.
End packed_operation.
Definition packed_operation := packed_operation.record.

Definition pack {A : Set} (function_parameter : operation A)
  : packed_operation :=
  let '{|
    operation.shell := shell; operation.protocol_data := protocol_data |} :=
    function_parameter in
  {| packed_operation.shell := shell;
    packed_operation.protocol_data := Operation_data protocol_data |}.

Reserved Notation "'packed_internal_operation".

Inductive packed_internal_operation_gadt : Set :=
| Internal_operation : forall {kind : Set},
  internal_operation kind -> packed_internal_operation_gadt

where "'packed_internal_operation" := (packed_internal_operation_gadt).

Definition packed_internal_operation := 'packed_internal_operation.

Fixpoint to_list (function_parameter : packed_contents_list)
  : list packed_contents :=
  match function_parameter with
  | Contents_list (Single o) => cons (Contents o) []
  | Contents_list (Cons o os) => cons (Contents o) (to_list (Contents_list os))
  end.

Fixpoint of_list (function_parameter : list packed_contents)
  : packed_contents_list :=
  match function_parameter with
  | [] =>
    (* ❌ Assert instruction is not handled. *)
    assert false
  | cons (Contents o) [] => Contents_list (Single o)
  | cons (Contents o) os =>
    let 'Contents_list os := of_list os in
    match (o, os) with
    | (Manager_operation _, Single (Manager_operation _)) =>
      Contents_list (Cons o os)
    | (Manager_operation _, Cons _ _) => Contents_list (Cons o os)
    | _ =>
      Pervasives.failwith
        "Operation list of length > 1 should only contains manager operations."
          % string
    end
  end.

Module Encoding.
  Import Data_encoding.
  
  Definition __case_value {A B : Set}
    (tag : Tezos_protocol_environment_alpha__Environment.Data_encoding.case_tag)
    (name : string)
    (args :
      Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding A)
    (proj : B -> option A) (inj : A -> B)
    : Tezos_protocol_environment_alpha__Environment.Data_encoding.case B :=
    __case_value (String.capitalize_ascii name) None tag
      (merge_objs (obj1 (req None None "kind" % string (constant name))) args)
      (fun x =>
        match proj x with
        | None => None
        | Some x => Some (tt, x)
        end)
      (fun function_parameter =>
        let '(tt, x) := function_parameter in
        inj x).
  
  Module Manager_operations.
    Reserved Notation "'case".
    
    Inductive case_gadt : Set :=
    | MCase : forall {a kind : Set},
      Z -> string ->
      Tezos_protocol_environment_alpha__Environment.Data_encoding.t a ->
      (packed_manager_operation -> option (manager_operation kind)) ->
      (manager_operation kind -> a) -> (a -> manager_operation kind) ->
      case_gadt
    
    where "'case" := (fun (kind : Set) => case_gadt).
    
    Definition case := 'case.
    
    Definition reveal_case : case Kind.reveal :=
      MCase
        {| case.MCase.tag := 0; case.MCase.name := "reveal" % string;
          case.MCase.encoding :=
            obj1
              (req None None "public_key" % string Signature.Public_key.encoding);
          case.MCase.select :=
            fun function_parameter =>
              match function_parameter with
              | Manager ((Reveal _) as op) => Some op
              | _ => None
              end;
          case.MCase.proj :=
            fun function_parameter =>
              let 'Reveal pkh := function_parameter in
              pkh; case.MCase.inj := fun pkh => Reveal pkh |}.
    
    Definition entrypoint_encoding
      : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
        Tezos_protocol_environment_alpha__Environment.Compare.String.t :=
      op_atat
        (def "entrypoint" % string (Some "entrypoint" % string)
          (Some "Named entrypoint to a Michelson smart contract" % string))
        (let builtin_case
          (tag : Z) (name :
          Tezos_protocol_environment_alpha__Environment.Compare.String.t)
          : Tezos_protocol_environment_alpha__Environment.Data_encoding.case
            Tezos_protocol_environment_alpha__Environment.Compare.String.t :=
          Data_encoding.__case_value name None
            (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag tag)
            (constant name)
            (fun n =>
              if op_eq n name then
                Some tt
              else
                None)
            (fun function_parameter =>
              let 'tt := function_parameter in
              name) in
        union None
          (cons (builtin_case 0 "default" % string)
            (cons (builtin_case 1 "root" % string)
              (cons (builtin_case 2 "do" % string)
                (cons (builtin_case 3 "set_delegate" % string)
                  (cons (builtin_case 4 "remove_delegate" % string)
                    (cons
                      (Data_encoding.__case_value "named" % string None
                        (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag
                          255) (Bounded.__string_value 31) (fun s => Some s)
                        (fun s => s)) []))))))).
    
    Definition transaction_case : case Kind.transaction :=
      MCase
        {| case.MCase.tag := 1; case.MCase.name := "transaction" % string;
          case.MCase.encoding :=
            obj3 (req None None "amount" % string Tez_repr.encoding)
              (req None None "destination" % string Contract_repr.encoding)
              (opt None None "parameters" % string
                (obj2 (req None None "entrypoint" % string entrypoint_encoding)
                  (req None None "value" % string Script_repr.lazy_expr_encoding)));
          case.MCase.select :=
            fun function_parameter =>
              match function_parameter with
              | Manager ((Transaction _) as op) => Some op
              | _ => None
              end;
          case.MCase.proj :=
            fun function_parameter =>
              let
                'Transaction {|
                  manager_operation.Transaction.amount := amount;
                    manager_operation.Transaction.parameters := parameters;
                    manager_operation.Transaction.entrypoint := entrypoint;
                    manager_operation.Transaction.destination := destination
                    |} := function_parameter in
              let parameters :=
                if
                  op_andand (Script_repr.is_unit_parameter parameters)
                    (op_eq entrypoint "default" % string) then
                  None
                else
                  Some (entrypoint, parameters) in
              (amount, destination, parameters);
          case.MCase.inj :=
            fun function_parameter =>
              let '(amount, destination, parameters) := function_parameter in
              let '(entrypoint, parameters) :=
                match parameters with
                | None => ("default" % string, Script_repr.unit_parameter)
                | Some (entrypoint, value) => (entrypoint, value)
                end in
              Transaction
                {| manager_operation.Transaction.amount := amount;
                  manager_operation.Transaction.parameters := parameters;
                  manager_operation.Transaction.entrypoint := entrypoint;
                  manager_operation.Transaction.destination := destination |} |}.
    
    Definition origination_case : case Kind.origination :=
      MCase
        {| case.MCase.tag := 2; case.MCase.name := "origination" % string;
          case.MCase.encoding :=
            obj3 (req None None "balance" % string Tez_repr.encoding)
              (opt None None "delegate" % string
                Signature.Public_key_hash.encoding)
              (req None None "script" % string Script_repr.encoding);
          case.MCase.select :=
            fun function_parameter =>
              match function_parameter with
              | Manager ((Origination _) as op) => Some op
              | _ => None
              end;
          case.MCase.proj :=
            fun function_parameter =>
              let
                'Origination {|
                  manager_operation.Origination.delegate := delegate;
                    manager_operation.Origination.script := script;
                    manager_operation.Origination.credit := credit;
                    manager_operation.Origination.preorigination := _
                    |} := function_parameter in
              (credit, delegate, script);
          case.MCase.inj :=
            fun function_parameter =>
              let '(credit, delegate, script) := function_parameter in
              Origination
                {| manager_operation.Origination.delegate := delegate;
                  manager_operation.Origination.script := script;
                  manager_operation.Origination.credit := credit;
                  manager_operation.Origination.preorigination := None |} |}.
    
    Definition delegation_case : case Kind.delegation :=
      MCase
        {| case.MCase.tag := 3; case.MCase.name := "delegation" % string;
          case.MCase.encoding :=
            obj1
              (opt None None "delegate" % string
                Signature.Public_key_hash.encoding);
          case.MCase.select :=
            fun function_parameter =>
              match function_parameter with
              | Manager ((Delegation _) as op) => Some op
              | _ => None
              end;
          case.MCase.proj :=
            fun function_parameter =>
              let 'Delegation key := function_parameter in
              key; case.MCase.inj := fun key => Delegation key |}.
    
    Definition encoding
      : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
        packed_manager_operation :=
      let make {A : Set} (function_parameter : case A)
        : Tezos_protocol_environment_alpha__Environment.Data_encoding.case
          packed_manager_operation :=
        let
          'MCase {|
            case.MCase.tag := tag;
              case.MCase.name := name;
              case.MCase.encoding := encoding;
              case.MCase.select := select;
              case.MCase.proj := proj;
              case.MCase.inj := inj
              |} := function_parameter in
        __case_value
          (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag tag)
          name encoding
          (fun o =>
            match select o with
            | None => None
            | Some o => Some (proj o)
            end) (fun x => Manager (inj x)) in
      union
        (Some
          (* ❌ Variants not supported *)
          variant)
        (cons (make reveal_case)
          (cons (make transaction_case)
            (cons (make origination_case) (cons (make delegation_case) [])))).
  End Manager_operations.
  
  Reserved Notation "'case".
  
  Inductive case_gadt : Set :=
  | Case : forall {a b : Set},
    Z -> string ->
    Tezos_protocol_environment_alpha__Environment.Data_encoding.t a ->
    (packed_contents -> option (contents b)) -> (contents b -> a) ->
    (a -> contents b) -> case_gadt
  
  where "'case" := (fun (b : Set) => case_gadt).
  
  Definition case := 'case.
  
  Definition endorsement_encoding
    : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
      Tezos_raw_protocol_alpha.Raw_level_repr.raw_level :=
    obj1 (req None None "level" % string Raw_level_repr.encoding).
  
  Definition endorsement_case : case Kind.endorsement :=
    Case
      {| case.Case.tag := 0; case.Case.name := "endorsement" % string;
        case.Case.encoding := endorsement_encoding;
        case.Case.select :=
          fun function_parameter =>
            match function_parameter with
            | Contents ((Endorsement _) as op) => Some op
            | _ => None
            end;
        case.Case.proj :=
          fun function_parameter =>
            let 'Endorsement {| contents.Endorsement.level := level |} :=
              function_parameter in
            level;
        case.Case.inj :=
          fun level => Endorsement {| contents.Endorsement.level := level |} |}.
  
  Definition endorsement_encoding
    : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
      (operation Kind.endorsement) :=
    let make {A : Set} (function_parameter : case A)
      : Tezos_protocol_environment_alpha__Environment.Data_encoding.case
        (contents A) :=
      let
        'Case {|
          case.Case.tag := tag;
            case.Case.name := name;
            case.Case.encoding := encoding;
            case.Case.select := _;
            case.Case.proj := proj;
            case.Case.inj := inj
            |} := function_parameter in
      __case_value
        (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag tag)
        name encoding (fun o => Some (proj o)) (fun x => inj x) in
    let to_list (function_parameter : contents_list Kind.endorsement)
      : contents Kind.endorsement :=
      let 'Single o := function_parameter in
      o in
    let of_list (o : contents Kind.endorsement)
      : contents_list Kind.endorsement :=
      Single o in
    op_atat
      (let arg := def "inlined.endorsement" % string in
      fun eta => arg None None eta)
      (conv
        (fun function_parameter =>
          let '{|
            operation.shell := shell;
              operation.protocol_data := {|
                protocol_data.contents := contents;
                  protocol_data.signature := signature
                  |}
              |} := function_parameter in
          (shell, (contents, signature)))
        (fun function_parameter =>
          let '(shell, (contents, signature)) := function_parameter in
          {| operation.shell := shell;
            operation.protocol_data :=
              {| protocol_data.contents := contents;
                protocol_data.signature := signature |} |}) None
        (merge_objs Operation.shell_header_encoding
          (obj2
            (req None None "operations" % string
              (op_atat
                (let arg := conv to_list of_list in
                fun eta => arg None eta)
                (op_atat
                  (let arg := def "inlined.endorsement.contents" % string in
                  fun eta => arg None None eta)
                  (union None (cons (make endorsement_case) [])))))
            (varopt None None "signature" % string Signature.encoding)))).
  
  Definition seed_nonce_revelation_case : case Kind.seed_nonce_revelation :=
    Case
      {| case.Case.tag := 1; case.Case.name := "seed_nonce_revelation" % string;
        case.Case.encoding :=
          obj2 (req None None "level" % string Raw_level_repr.encoding)
            (req None None "nonce" % string Seed_repr.nonce_encoding);
        case.Case.select :=
          fun function_parameter =>
            match function_parameter with
            | Contents ((Seed_nonce_revelation _) as op) => Some op
            | _ => None
            end;
        case.Case.proj :=
          fun function_parameter =>
            let
              'Seed_nonce_revelation {|
                contents.Seed_nonce_revelation.level := level;
                  contents.Seed_nonce_revelation.nonce := nonce
                  |} := function_parameter in
            (level, nonce);
        case.Case.inj :=
          fun function_parameter =>
            let '(level, nonce) := function_parameter in
            Seed_nonce_revelation
              {| contents.Seed_nonce_revelation.level := level;
                contents.Seed_nonce_revelation.nonce := nonce |} |}.
  
  Definition double_endorsement_evidence_case
    : case Kind.double_endorsement_evidence :=
    Case
      {| case.Case.tag := 2;
        case.Case.name := "double_endorsement_evidence" % string;
        case.Case.encoding :=
          obj2
            (req None None "op1" % string
              (dynamic_size None endorsement_encoding))
            (req None None "op2" % string
              (dynamic_size None endorsement_encoding));
        case.Case.select :=
          fun function_parameter =>
            match function_parameter with
            | Contents ((Double_endorsement_evidence _) as op) => Some op
            | _ => None
            end;
        case.Case.proj :=
          fun function_parameter =>
            let
              'Double_endorsement_evidence {|
                contents.Double_endorsement_evidence.op1 := op1;
                  contents.Double_endorsement_evidence.op2 := op2
                  |} := function_parameter in
            (op1, op2);
        case.Case.inj :=
          fun function_parameter =>
            let '(op1, op2) := function_parameter in
            Double_endorsement_evidence
              {| contents.Double_endorsement_evidence.op1 := op1;
                contents.Double_endorsement_evidence.op2 := op2 |} |}.
  
  Definition double_baking_evidence_case : case Kind.double_baking_evidence :=
    Case
      {| case.Case.tag := 3;
        case.Case.name := "double_baking_evidence" % string;
        case.Case.encoding :=
          obj2
            (req None None "bh1" % string
              (dynamic_size None Block_header_repr.encoding))
            (req None None "bh2" % string
              (dynamic_size None Block_header_repr.encoding));
        case.Case.select :=
          fun function_parameter =>
            match function_parameter with
            | Contents ((Double_baking_evidence _) as op) => Some op
            | _ => None
            end;
        case.Case.proj :=
          fun function_parameter =>
            let
              'Double_baking_evidence {|
                contents.Double_baking_evidence.bh1 := bh1;
                  contents.Double_baking_evidence.bh2 := bh2
                  |} := function_parameter in
            (bh1, bh2);
        case.Case.inj :=
          fun function_parameter =>
            let '(bh1, bh2) := function_parameter in
            Double_baking_evidence
              {| contents.Double_baking_evidence.bh1 := bh1;
                contents.Double_baking_evidence.bh2 := bh2 |} |}.
  
  Definition activate_account_case : case Kind.activate_account :=
    Case
      {| case.Case.tag := 4; case.Case.name := "activate_account" % string;
        case.Case.encoding :=
          obj2 (req None None "pkh" % string Ed25519.Public_key_hash.encoding)
            (req None None "secret" % string
              Blinded_public_key_hash.activation_code_encoding);
        case.Case.select :=
          fun function_parameter =>
            match function_parameter with
            | Contents ((Activate_account _) as op) => Some op
            | _ => None
            end;
        case.Case.proj :=
          fun function_parameter =>
            let
              'Activate_account {|
                contents.Activate_account.id := id;
                  contents.Activate_account.activation_code := activation_code
                  |} := function_parameter in
            (id, activation_code);
        case.Case.inj :=
          fun function_parameter =>
            let '(id, activation_code) := function_parameter in
            Activate_account
              {| contents.Activate_account.id := id;
                contents.Activate_account.activation_code := activation_code |}
        |}.
  
  Definition proposals_case : case Kind.proposals :=
    Case
      {| case.Case.tag := 5; case.Case.name := "proposals" % string;
        case.Case.encoding :=
          obj3
            (req None None "source" % string Signature.Public_key_hash.encoding)
            (req None None "period" % string Voting_period_repr.encoding)
            (req None None "proposals" % string
              (__list_value None Protocol_hash.encoding));
        case.Case.select :=
          fun function_parameter =>
            match function_parameter with
            | Contents ((Proposals _) as op) => Some op
            | _ => None
            end;
        case.Case.proj :=
          fun function_parameter =>
            let
              'Proposals {|
                contents.Proposals.source := source;
                  contents.Proposals.period := period;
                  contents.Proposals.proposals := proposals
                  |} := function_parameter in
            (source, period, proposals);
        case.Case.inj :=
          fun function_parameter =>
            let '(source, period, proposals) := function_parameter in
            Proposals
              {| contents.Proposals.source := source;
                contents.Proposals.period := period;
                contents.Proposals.proposals := proposals |} |}.
  
  Definition ballot_case : case Kind.ballot :=
    Case
      {| case.Case.tag := 6; case.Case.name := "ballot" % string;
        case.Case.encoding :=
          obj4
            (req None None "source" % string Signature.Public_key_hash.encoding)
            (req None None "period" % string Voting_period_repr.encoding)
            (req None None "proposal" % string Protocol_hash.encoding)
            (req None None "ballot" % string Vote_repr.ballot_encoding);
        case.Case.select :=
          fun function_parameter =>
            match function_parameter with
            | Contents ((Ballot _) as op) => Some op
            | _ => None
            end;
        case.Case.proj :=
          fun function_parameter =>
            let
              'Ballot {|
                contents.Ballot.source := source;
                  contents.Ballot.period := period;
                  contents.Ballot.proposal := proposal;
                  contents.Ballot.ballot := ballot
                  |} := function_parameter in
            (source, period, proposal, ballot);
        case.Case.inj :=
          fun function_parameter =>
            let '(source, period, proposal, ballot) := function_parameter in
            Ballot
              {| contents.Ballot.source := source;
                contents.Ballot.period := period;
                contents.Ballot.proposal := proposal;
                contents.Ballot.ballot := ballot |} |}.
  
  Definition manager_encoding
    : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
      (Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t
        * Tezos_raw_protocol_alpha.Tez_repr.t *
        Tezos_protocol_environment_alpha__Environment.Z.t *
        Tezos_protocol_environment_alpha__Environment.Z.t *
        Tezos_protocol_environment_alpha__Environment.Z.t) :=
    obj5 (req None None "source" % string Signature.Public_key_hash.encoding)
      (req None None "fee" % string Tez_repr.encoding)
      (req None None "counter" % string (check_size 10 n))
      (req None None "gas_limit" % string (check_size 10 n))
      (req None None "storage_limit" % string (check_size 10 n)).
  
  Definition extract {A : Set} (function_parameter : contents (Kind.manager A))
    : Tezos_protocol_environment_alpha__Environment.Signature.public_key_hash *
      Tezos_raw_protocol_alpha.Tez_repr.tez * counter *
      Tezos_protocol_environment_alpha__Environment.Z.t *
      Tezos_protocol_environment_alpha__Environment.Z.t :=
    let
      'Manager_operation {|
        contents.Manager_operation.source := source;
          contents.Manager_operation.fee := fee;
          contents.Manager_operation.counter := counter;
          contents.Manager_operation.operation := _;
          contents.Manager_operation.gas_limit := gas_limit;
          contents.Manager_operation.storage_limit := storage_limit
          |} := function_parameter in
    (source, fee, counter, gas_limit, storage_limit).
  
  Definition rebuild {A : Set}
    (function_parameter :
      Tezos_protocol_environment_alpha__Environment.Signature.public_key_hash *
        Tezos_raw_protocol_alpha.Tez_repr.tez * counter *
        Tezos_protocol_environment_alpha__Environment.Z.t *
        Tezos_protocol_environment_alpha__Environment.Z.t)
    : manager_operation A -> contents (Kind.manager A) :=
    let '(source, fee, counter, gas_limit, storage_limit) := function_parameter
      in
    fun operation =>
      Manager_operation
        {| contents.Manager_operation.source := source;
          contents.Manager_operation.fee := fee;
          contents.Manager_operation.counter := counter;
          contents.Manager_operation.operation := operation;
          contents.Manager_operation.gas_limit := gas_limit;
          contents.Manager_operation.storage_limit := storage_limit |}.
  
  Definition make_manager_case {A : Set}
    (tag : Z) (function_parameter : Manager_operations.case A)
    : case (Kind.manager A) :=
    let 'Manager_operations.MCase mcase := function_parameter in
    Case
      {| case.Case.tag := tag;
        case.Case.name := Manager_operations.case.MCase.name mcase;
        case.Case.encoding :=
          merge_objs manager_encoding
            (Manager_operations.case.MCase.encoding mcase);
        case.Case.select :=
          fun function_parameter =>
            match function_parameter with
            |
              Contents
                (Manager_operation
                  ({| contents.Manager_operation.operation := operation |} as op))
              =>
              match
                (Manager_operations.case.MCase.select mcase) (Manager operation)
                with
              | None => None
              | Some operation =>
                Some
                  (Manager_operation
                    (* ❌ Record substitution not handled *)
                    record_substitution)
              end
            | _ => None
            end;
        case.Case.proj :=
          fun function_parameter =>
            let
              '(Manager_operation {|
                contents.Manager_operation.operation := operation |}) as op :=
              function_parameter in
            ((extract op),
              ((Manager_operations.case.MCase.proj mcase) operation));
        case.Case.inj :=
          fun function_parameter =>
            let '(op, contents) := function_parameter in
            rebuild op ((Manager_operations.case.MCase.inj mcase) contents) |}.
  
  Definition reveal_case : case (Kind.manager Kind.reveal) :=
    make_manager_case 107 Manager_operations.reveal_case.
  
  Definition transaction_case : case (Kind.manager Kind.transaction) :=
    make_manager_case 108 Manager_operations.transaction_case.
  
  Definition origination_case : case (Kind.manager Kind.origination) :=
    make_manager_case 109 Manager_operations.origination_case.
  
  Definition delegation_case : case (Kind.manager Kind.delegation) :=
    make_manager_case 110 Manager_operations.delegation_case.
  
  Definition contents_encoding
    : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
      packed_contents :=
    let make {A : Set} (function_parameter : case A)
      : Tezos_protocol_environment_alpha__Environment.Data_encoding.case
        packed_contents :=
      let
        'Case {|
          case.Case.tag := tag;
            case.Case.name := name;
            case.Case.encoding := encoding;
            case.Case.select := select;
            case.Case.proj := proj;
            case.Case.inj := inj
            |} := function_parameter in
      __case_value
        (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag tag)
        name encoding
        (fun o =>
          match select o with
          | None => None
          | Some o => Some (proj o)
          end) (fun x => Contents (inj x)) in
    op_atat
      (let arg := def "operation.alpha.contents" % string in
      fun eta => arg None None eta)
      (union None
        (cons (make endorsement_case)
          (cons (make seed_nonce_revelation_case)
            (cons (make double_endorsement_evidence_case)
              (cons (make double_baking_evidence_case)
                (cons (make activate_account_case)
                  (cons (make proposals_case)
                    (cons (make ballot_case)
                      (cons (make reveal_case)
                        (cons (make transaction_case)
                          (cons (make origination_case)
                            (cons (make delegation_case) [])))))))))))).
  
  Definition contents_list_encoding
    : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
      packed_contents_list :=
    conv to_list of_list None (__Variable.__list_value None contents_encoding).
  
  Definition optional_signature_encoding
    : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
      (option Tezos_protocol_environment_alpha__Environment.Signature.t) :=
    conv
      (fun function_parameter =>
        match function_parameter with
        | Some s => s
        | None => Signature.zero
        end)
      (fun s =>
        if Signature.equal s Signature.zero then
          None
        else
          Some s) None Signature.encoding.
  
  Definition protocol_data_encoding
    : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
      packed_protocol_data :=
    op_atat
      (let arg := def "operation.alpha.contents_and_signature" % string in
      fun eta => arg None None eta)
      (conv
        (fun function_parameter =>
          let
            'Operation_data {|
              protocol_data.contents := contents;
                protocol_data.signature := signature
                |} := function_parameter in
          ((Contents_list contents), signature))
        (fun function_parameter =>
          let '(Contents_list contents, signature) := function_parameter in
          Operation_data
            {| protocol_data.contents := contents;
              protocol_data.signature := signature |}) None
        (obj2 (req None None "contents" % string contents_list_encoding)
          (req None None "signature" % string optional_signature_encoding))).
  
  Definition operation_encoding
    : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
      packed_operation :=
    conv
      (fun function_parameter =>
        let '{|
          packed_operation.shell := shell;
            packed_operation.protocol_data := protocol_data
            |} := function_parameter in
        (shell, protocol_data))
      (fun function_parameter =>
        let '(shell, protocol_data) := function_parameter in
        {| packed_operation.shell := shell;
          packed_operation.protocol_data := protocol_data |}) None
      (merge_objs Operation.shell_header_encoding protocol_data_encoding).
  
  Definition unsigned_operation_encoding
    : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
      (Tezos_protocol_environment_alpha__Environment.Operation.shell_header *
        packed_contents_list) :=
    op_atat
      (let arg := def "operation.alpha.unsigned_operation" % string in
      fun eta => arg None None eta)
      (merge_objs Operation.shell_header_encoding
        (obj1 (req None None "contents" % string contents_list_encoding))).
  
  Definition internal_operation_encoding
    : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
      packed_internal_operation :=
    op_atat
      (let arg := def "operation.alpha.internal_operation" % string in
      fun eta => arg None None eta)
      (conv
        (fun function_parameter =>
          let
            'Internal_operation {|
              internal_operation.source := source;
                internal_operation.operation := operation;
                internal_operation.nonce := nonce
                |} := function_parameter in
          ((source, nonce), (Manager operation)))
        (fun function_parameter =>
          let '((source, nonce), Manager operation) := function_parameter in
          Internal_operation
            {| internal_operation.source := source;
              internal_operation.operation := operation;
              internal_operation.nonce := nonce |}) None
        (merge_objs
          (obj2 (req None None "source" % string Contract_repr.encoding)
            (req None None "nonce" % string uint16)) Manager_operations.encoding)).
End Encoding.

Definition encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    packed_operation := Encoding.operation_encoding.

Definition contents_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    packed_contents := Encoding.contents_encoding.

Definition contents_list_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    packed_contents_list := Encoding.contents_list_encoding.

Definition protocol_data_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    packed_protocol_data := Encoding.protocol_data_encoding.

Definition unsigned_operation_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    (Tezos_protocol_environment_alpha__Environment.Operation.shell_header *
      packed_contents_list) := Encoding.unsigned_operation_encoding.

Definition internal_operation_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    packed_internal_operation := Encoding.internal_operation_encoding.

Definition raw {A : Set} (function_parameter : operation A)
  : Tezos_protocol_environment_alpha__Environment.Operation.t :=
  let '{|
    operation.shell := shell; operation.protocol_data := protocol_data |} :=
    function_parameter in
  let proto :=
    Data_encoding.Binary.to_bytes_exn protocol_data_encoding
      (Operation_data protocol_data) in
  {| Tezos_protocol_environment_alpha__Environment.Operation.t.shell := shell;
    Tezos_protocol_environment_alpha__Environment.Operation.t.proto := proto |}.

Definition acceptable_passes (op : packed_operation) : list Z :=
  let 'Operation_data protocol_data := packed_operation.protocol_data op in
  match protocol_data.contents protocol_data with
  | Single (Endorsement _) => cons 0 []
  | Single (Proposals _) => cons 1 []
  | Single (Ballot _) => cons 1 []
  | Single (Seed_nonce_revelation _) => cons 2 []
  | Single (Double_endorsement_evidence _) => cons 2 []
  | Single (Double_baking_evidence _) => cons 2 []
  | Single (Activate_account _) => cons 2 []
  | Single (Manager_operation _) => cons 3 []
  | Cons _ _ => cons 3 []
  end.

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Top-level evaluations are considered as an error as sources of side-effects *)
Compute
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "operation.invalid_signature" % string
      "Invalid operation signature" % string
      "The operation signature is ill-formed or has been made with the wrong public key"
        % string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let 'tt := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "The operation signature is invalid" % string
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
                "The operation signature is invalid" % string)))
      Data_encoding.__unit_value
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_signature
          => Some tt
        | _ => None
        end)
      (fun function_parameter =>
        let 'tt := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_signature)
    in
  register_error_kind
    (* ❌ Variants not supported *)
    variant "operation.missing_signature" % string
    "Missing operation signature" % string
    "The operation is of a kind that must be signed, but the signature is missing"
      % string
    (Some
      (fun ppf =>
        fun function_parameter =>
          let 'tt := function_parameter in
          Format.fprintf ppf
            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                "The operation requires a signature" % string
                Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
              "The operation requires a signature" % string)))
    Data_encoding.__unit_value
    (fun function_parameter =>
      match function_parameter with
      |
        Tezos_protocol_environment_alpha__Environment.Error_monad.Missing_signature
        => Some tt
      | _ => None
      end)
    (fun function_parameter =>
      let 'tt := function_parameter in
      Tezos_protocol_environment_alpha__Environment.Error_monad.Missing_signature).

Definition check_signature_sync {A : Set}
  (key : Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t)
  (chain_id : Tezos_protocol_environment_alpha__Environment.Chain_id.t)
  (function_parameter : operation A)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit :=
  let '{|
    operation.shell := shell; operation.protocol_data := protocol_data |} :=
    function_parameter in
  let check
    (watermark :
    Tezos_protocol_environment_alpha__Environment.Signature.watermark) (contents
    : packed_contents_list) (signature :
    Tezos_protocol_environment_alpha__Environment.Signature.t)
    : Tezos_protocol_environment_alpha__Environment.Pervasives.result unit
      (list Tezos_protocol_environment_alpha__Environment.Error_monad.__error) :=
    let unsigned_operation :=
      Data_encoding.Binary.to_bytes_exn unsigned_operation_encoding
        (shell, contents) in
    if Signature.check (Some watermark) key signature unsigned_operation then
      Tezos_protocol_environment_alpha__Environment.Pervasives.Ok tt
    else
      __error_value
        Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_signature
    in
  match
    ((protocol_data.contents protocol_data),
      (protocol_data.signature protocol_data)) with
  | (Single _, None) =>
    __error_value
      Tezos_protocol_environment_alpha__Environment.Error_monad.Missing_signature
  | (Cons _ _, None) =>
    __error_value
      Tezos_protocol_environment_alpha__Environment.Error_monad.Missing_signature
  | ((Single (Endorsement _)) as contents, Some signature) =>
    check
      (Tezos_protocol_environment_alpha__Environment.Signature.Endorsement
        chain_id) (Contents_list contents) signature
  | ((Single _) as contents, Some signature) =>
    check
      Tezos_protocol_environment_alpha__Environment.Signature.Generic_operation
      (Contents_list contents) signature
  | ((Cons _ _) as contents, Some signature) =>
    check
      Tezos_protocol_environment_alpha__Environment.Signature.Generic_operation
      (Contents_list contents) signature
  end.

Definition check_signature {A : Set}
  (pk : Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t)
  (chain_id : Tezos_protocol_environment_alpha__Environment.Chain_id.t)
  (op : operation A)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
  Lwt.__return (check_signature_sync pk chain_id op).

Definition hash_raw
  : Tezos_protocol_environment_alpha__Environment.Operation.t ->
  Tezos_protocol_environment_alpha__Environment.Operation_hash.t :=
  Operation.__hash_value.

Definition __hash_value {A : Set} (o : operation A)
  : Tezos_protocol_environment_alpha__Environment.Operation_hash.t :=
  let proto :=
    Data_encoding.Binary.to_bytes_exn protocol_data_encoding
      (Operation_data (operation.protocol_data o)) in
  Operation.__hash_value
    {| raw.shell := operation.shell o; raw.proto := proto |}.

Definition hash_packed (o : packed_operation)
  : Tezos_protocol_environment_alpha__Environment.Operation_hash.t :=
  let proto :=
    Data_encoding.Binary.to_bytes_exn protocol_data_encoding
      (packed_operation.protocol_data o) in
  Operation.__hash_value
    {| raw.shell := packed_operation.shell o; raw.proto := proto |}.

Reserved Notation "'eq".

Inductive eq_gadt : Set :=
| Eq : eq_gadt

where "'eq" := (fun (a b : Set) => eq_gadt).

Definition eq := 'eq.

Definition equal_manager_operation_kind {a b : Set}
  (op1 : manager_operation a) (op2 : manager_operation b) : option (eq a b) :=
  match (op1, op2) with
  | (Reveal _, Reveal _) => Some Eq
  | (Reveal _, _) => None
  | (Transaction _, Transaction _) => Some Eq
  | (Transaction _, _) => None
  | (Origination _, Origination _) => Some Eq
  | (Origination _, _) => None
  | (Delegation _, Delegation _) => Some Eq
  | (Delegation _, _) => None
  end.

Definition equal_contents_kind {a b : Set} (op1 : contents a) (op2 : contents b)
  : option (eq a b) :=
  match (op1, op2) with
  | (Endorsement _, Endorsement _) => Some Eq
  | (Endorsement _, _) => None
  | (Seed_nonce_revelation _, Seed_nonce_revelation _) => Some Eq
  | (Seed_nonce_revelation _, _) => None
  | (Double_endorsement_evidence _, Double_endorsement_evidence _) => Some Eq
  | (Double_endorsement_evidence _, _) => None
  | (Double_baking_evidence _, Double_baking_evidence _) => Some Eq
  | (Double_baking_evidence _, _) => None
  | (Activate_account _, Activate_account _) => Some Eq
  | (Activate_account _, _) => None
  | (Proposals _, Proposals _) => Some Eq
  | (Proposals _, _) => None
  | (Ballot _, Ballot _) => Some Eq
  | (Ballot _, _) => None
  | (Manager_operation op1, Manager_operation op2) =>
    match
      equal_manager_operation_kind (contents.Manager_operation.operation op1)
        (contents.Manager_operation.operation op2) with
    | None => None
    | Some Eq => Some Eq
    end
  | (Manager_operation _, _) => None
  end.

Fixpoint equal_contents_kind_list {a b : Set}
  (op1 : contents_list a) (op2 : contents_list b) : option (eq a b) :=
  match (op1, op2) with
  | (Single op1, Single op2) => equal_contents_kind op1 op2
  | (Single _, Cons _ _) => None
  | (Cons _ _, Single _) => None
  | (Cons op1 ops1, Cons op2 ops2) =>
    match equal_contents_kind op1 op2 with
    | None => None
    | Some Eq =>
      match equal_contents_kind_list ops1 ops2 with
      | None => None
      | Some Eq => Some Eq
      end
    end
  end.

Definition equal {a b : Set} (op1 : operation a) (op2 : operation b)
  : option (eq a b) :=
  if not (Operation_hash.equal (__hash_value op1) (__hash_value op2)) then
    None
  else
    equal_contents_kind_list
      (protocol_data.contents (operation.protocol_data op1))
      (protocol_data.contents (operation.protocol_data op2)).

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

(* Tezos Protocol Implementation - Low level Repr. of Operations *)

module Kind : sig
  type seed_nonce_revelation = Seed_nonce_revelation_kind

  type double_endorsement_evidence = Double_endorsement_evidence_kind

  type double_baking_evidence = Double_baking_evidence_kind

  type activate_account = Activate_account_kind

  type endorsement = Endorsement_kind

  type proposals = Proposals_kind

  type ballot = Ballot_kind

  type reveal = Reveal_kind

  type transaction = Transaction_kind

  type origination = Origination_kind

  type delegation = Delegation_kind

  type 'a manager =
    | Reveal_manager_kind : reveal manager
    | Transaction_manager_kind : transaction manager
    | Origination_manager_kind : origination manager
    | Delegation_manager_kind : delegation manager
end

type raw = Operation.t = {shell : Operation.shell_header; proto : MBytes.t}

val raw_encoding : raw Data_encoding.t

type 'kind operation = {
  shell : Operation.shell_header;
  protocol_data : 'kind protocol_data;
}

and 'kind protocol_data = {
  contents : 'kind contents_list;
  signature : Signature.t option;
}

and _ contents_list =
  | Single : 'kind contents -> 'kind contents_list
  | Cons :
      'kind Kind.manager contents * 'rest Kind.manager contents_list
      -> ('kind * 'rest) Kind.manager contents_list

and _ contents =
  | Endorsement : {level : Raw_level_repr.t} -> Kind.endorsement contents
  | Seed_nonce_revelation : {
      level : Raw_level_repr.t;
      nonce : Seed_repr.nonce;
    }
      -> Kind.seed_nonce_revelation contents
  | Double_endorsement_evidence : {
      op1 : Kind.endorsement operation;
      op2 : Kind.endorsement operation;
    }
      -> Kind.double_endorsement_evidence contents
  | Double_baking_evidence : {
      bh1 : Block_header_repr.t;
      bh2 : Block_header_repr.t;
    }
      -> Kind.double_baking_evidence contents
  | Activate_account : {
      id : Ed25519.Public_key_hash.t;
      activation_code : Blinded_public_key_hash.activation_code;
    }
      -> Kind.activate_account contents
  | Proposals : {
      source : Signature.Public_key_hash.t;
      period : Voting_period_repr.t;
      proposals : Protocol_hash.t list;
    }
      -> Kind.proposals contents
  | Ballot : {
      source : Signature.Public_key_hash.t;
      period : Voting_period_repr.t;
      proposal : Protocol_hash.t;
      ballot : Vote_repr.ballot;
    }
      -> Kind.ballot contents
  | Manager_operation : {
      source : Signature.Public_key_hash.t;
      fee : Tez_repr.tez;
      counter : counter;
      operation : 'kind manager_operation;
      gas_limit : Z.t;
      storage_limit : Z.t;
    }
      -> 'kind Kind.manager contents

and _ manager_operation =
  | Reveal : Signature.Public_key.t -> Kind.reveal manager_operation
  | Transaction : {
      amount : Tez_repr.tez;
      parameters : Script_repr.lazy_expr;
      entrypoint : string;
      destination : Contract_repr.contract;
    }
      -> Kind.transaction manager_operation
  | Origination : {
      delegate : Signature.Public_key_hash.t option;
      script : Script_repr.t;
      credit : Tez_repr.tez;
      preorigination : Contract_repr.t option;
    }
      -> Kind.origination manager_operation
  | Delegation :
      Signature.Public_key_hash.t option
      -> Kind.delegation manager_operation

and counter = Z.t

type 'kind internal_operation = {
  source : Contract_repr.contract;
  operation : 'kind manager_operation;
  nonce : int;
}

type packed_manager_operation =
  | Manager : 'kind manager_operation -> packed_manager_operation

type packed_contents = Contents : 'kind contents -> packed_contents

type packed_contents_list =
  | Contents_list : 'kind contents_list -> packed_contents_list

val of_list : packed_contents list -> packed_contents_list

val to_list : packed_contents_list -> packed_contents list

type packed_protocol_data =
  | Operation_data : 'kind protocol_data -> packed_protocol_data

type packed_operation = {
  shell : Operation.shell_header;
  protocol_data : packed_protocol_data;
}

val pack : 'kind operation -> packed_operation

type packed_internal_operation =
  | Internal_operation : 'kind internal_operation -> packed_internal_operation

val manager_kind : 'kind manager_operation -> 'kind Kind.manager

val encoding : packed_operation Data_encoding.t

val contents_encoding : packed_contents Data_encoding.t

val contents_list_encoding : packed_contents_list Data_encoding.t

val protocol_data_encoding : packed_protocol_data Data_encoding.t

val unsigned_operation_encoding :
  (Operation.shell_header * packed_contents_list) Data_encoding.t

val raw : _ operation -> raw

val hash_raw : raw -> Operation_hash.t

val hash : _ operation -> Operation_hash.t

val hash_packed : packed_operation -> Operation_hash.t

val acceptable_passes : packed_operation -> int list

type error += Missing_signature (* `Permanent *)

type error += Invalid_signature (* `Permanent *)

val check_signature :
  Signature.Public_key.t -> Chain_id.t -> _ operation -> unit tzresult Lwt.t

val check_signature_sync :
  Signature.Public_key.t -> Chain_id.t -> _ operation -> unit tzresult

val internal_operation_encoding : packed_internal_operation Data_encoding.t

type ('a, 'b) eq = Eq : ('a, 'a) eq

val equal : 'a operation -> 'b operation -> ('a, 'b) eq option

module Encoding : sig
  type 'b case =
    | Case : {
        tag : int;
        name : string;
        encoding : 'a Data_encoding.t;
        select : packed_contents -> 'b contents option;
        proj : 'b contents -> 'a;
        inj : 'a -> 'b contents;
      }
        -> 'b case

  val endorsement_case : Kind.endorsement case

  val seed_nonce_revelation_case : Kind.seed_nonce_revelation case

  val double_endorsement_evidence_case : Kind.double_endorsement_evidence case

  val double_baking_evidence_case : Kind.double_baking_evidence case

  val activate_account_case : Kind.activate_account case

  val proposals_case : Kind.proposals case

  val ballot_case : Kind.ballot case

  val reveal_case : Kind.reveal Kind.manager case

  val transaction_case : Kind.transaction Kind.manager case

  val origination_case : Kind.origination Kind.manager case

  val delegation_case : Kind.delegation Kind.manager case

  module Manager_operations : sig
    type 'b case =
      | MCase : {
          tag : int;
          name : string;
          encoding : 'a Data_encoding.t;
          select : packed_manager_operation -> 'kind manager_operation option;
          proj : 'kind manager_operation -> 'a;
          inj : 'a -> 'kind manager_operation;
        }
          -> 'kind case

    val reveal_case : Kind.reveal case

    val transaction_case : Kind.transaction case

    val origination_case : Kind.origination case

    val delegation_case : Kind.delegation case
  end
end

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Module Kind.
  Inductive seed_nonce_revelation : Set :=
  | Seed_nonce_revelation_kind : seed_nonce_revelation.
  
  Inductive double_endorsement_evidence : Set :=
  | Double_endorsement_evidence_kind : double_endorsement_evidence.
  
  Inductive double_baking_evidence : Set :=
  | Double_baking_evidence_kind : double_baking_evidence.
  
  Inductive activate_account : Set :=
  | Activate_account_kind : activate_account.
  
  Inductive endorsement : Set :=
  | Endorsement_kind : endorsement.
  
  Inductive proposals : Set :=
  | Proposals_kind : proposals.
  
  Inductive ballot : Set :=
  | Ballot_kind : ballot.
  
  Inductive reveal : Set :=
  | Reveal_kind : reveal.
  
  Inductive transaction : Set :=
  | Transaction_kind : transaction.
  
  Inductive origination : Set :=
  | Origination_kind : origination.
  
  Inductive delegation : Set :=
  | Delegation_kind : delegation.
  
  Reserved Notation "'manager".
  
  Inductive manager_gadt : Set :=
  | Reveal_manager_kind : manager_gadt
  | Transaction_manager_kind : manager_gadt
  | Origination_manager_kind : manager_gadt
  | Delegation_manager_kind : manager_gadt
  
  where "'manager" := (fun (a : Set) => manager_gadt).
  
  Definition manager := 'manager.
End Kind.

Module raw.
  Record record := {
    shell : Tezos_protocol_environment_alpha__Environment.Operation.shell_header;
    proto : Tezos_protocol_environment_alpha__Environment.MBytes.t }.
End raw.
Definition raw := raw.record.

Parameter raw_encoding :
  Tezos_protocol_environment_alpha__Environment.Data_encoding.t raw.

Reserved Notation "'operation".
Reserved Notation "'protocol_data".
Reserved Notation "'contents_list".
Reserved Notation "'contents".
Reserved Notation "'manager_operation".
Reserved Notation "'counter".

Module protocol_data_skeleton.
  Record record {contents signature : Set} := {
    contents : contents;
    signature : signature }.
  Arguments record : clear implicits.
End protocol_data_skeleton.
Definition protocol_data_skeleton := protocol_data_skeleton.record.

Module operation_skeleton.
  Record record {shell protocol_data : Set} := {
    shell : shell;
    protocol_data : protocol_data }.
  Arguments record : clear implicits.
End operation_skeleton.
Definition operation_skeleton := operation_skeleton.record.

Inductive contents_list_gadt : Set :=
| Single : forall {kind : Set}, 'contents kind -> contents_list_gadt
| Cons : forall {kind : Set},
  'contents (Kind.manager kind) -> contents_list_gadt -> contents_list_gadt

with contents_gadt : Set :=
| Endorsement : Tezos_raw_protocol_alpha.Raw_level_repr.t -> contents_gadt
| Seed_nonce_revelation :
  Tezos_raw_protocol_alpha.Raw_level_repr.t ->
  Tezos_raw_protocol_alpha.Seed_repr.nonce -> contents_gadt
| Double_endorsement_evidence :
  'operation Kind.endorsement -> 'operation Kind.endorsement -> contents_gadt
| Double_baking_evidence :
  Tezos_raw_protocol_alpha.Block_header_repr.t ->
  Tezos_raw_protocol_alpha.Block_header_repr.t -> contents_gadt
| Activate_account :
  Tezos_protocol_environment_alpha__Environment.Ed25519.Public_key_hash.t ->
  Tezos_raw_protocol_alpha.Blinded_public_key_hash.activation_code ->
  contents_gadt
| Proposals :
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Tezos_raw_protocol_alpha.Voting_period_repr.t ->
  list Tezos_protocol_environment_alpha__Environment.Protocol_hash.t ->
  contents_gadt
| Ballot :
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Tezos_raw_protocol_alpha.Voting_period_repr.t ->
  Tezos_protocol_environment_alpha__Environment.Protocol_hash.t ->
  Tezos_raw_protocol_alpha.Vote_repr.ballot -> contents_gadt
| Manager_operation : forall {kind : Set},
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Tezos_raw_protocol_alpha.Tez_repr.tez -> 'counter ->
  'manager_operation kind ->
  Tezos_protocol_environment_alpha__Environment.Z.t ->
  Tezos_protocol_environment_alpha__Environment.Z.t -> contents_gadt

with manager_operation_gadt : Set :=
| Reveal :
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t ->
  manager_operation_gadt
| Transaction :
  Tezos_raw_protocol_alpha.Tez_repr.tez ->
  Tezos_raw_protocol_alpha.Script_repr.lazy_expr -> string ->
  Tezos_raw_protocol_alpha.Contract_repr.contract -> manager_operation_gadt
| Origination :
  option
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Tezos_raw_protocol_alpha.Script_repr.t ->
  Tezos_raw_protocol_alpha.Tez_repr.tez ->
  option Tezos_raw_protocol_alpha.Contract_repr.t -> manager_operation_gadt
| Delegation :
  option
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  manager_operation_gadt

where "'operation" := (fun (kind : Set) =>
  operation_skeleton
    Tezos_protocol_environment_alpha__Environment.Operation.shell_header
    ('protocol_data kind))
and "'protocol_data" := (fun (kind : Set) =>
  protocol_data_skeleton ('contents_list kind)
    (option Tezos_protocol_environment_alpha__Environment.Signature.t))
and "'contents_list" := (fun (_ : Set) => contents_list_gadt)
and "'contents" := (fun (_ : Set) => contents_gadt)
and "'manager_operation" := (fun (_ : Set) => manager_operation_gadt)
and "'counter" := (Tezos_protocol_environment_alpha__Environment.Z.t).

Definition operation := 'operation.
Definition protocol_data := 'protocol_data.
Definition contents_list := 'contents_list.
Definition contents := 'contents.
Definition manager_operation := 'manager_operation.
Definition counter := 'counter.

Module internal_operation.
  Record record {kind : Set} := {
    source : Tezos_raw_protocol_alpha.Contract_repr.contract;
    operation : manager_operation kind;
    nonce : Z }.
  Arguments record : clear implicits.
End internal_operation.
Definition internal_operation := internal_operation.record.

Reserved Notation "'packed_manager_operation".

Inductive packed_manager_operation_gadt : Set :=
| Manager : forall {kind : Set},
  manager_operation kind -> packed_manager_operation_gadt

where "'packed_manager_operation" := (packed_manager_operation_gadt).

Definition packed_manager_operation := 'packed_manager_operation.

Reserved Notation "'packed_contents".

Inductive packed_contents_gadt : Set :=
| Contents : forall {kind : Set}, contents kind -> packed_contents_gadt

where "'packed_contents" := (packed_contents_gadt).

Definition packed_contents := 'packed_contents.

Reserved Notation "'packed_contents_list".

Inductive packed_contents_list_gadt : Set :=
| Contents_list : forall {kind : Set},
  contents_list kind -> packed_contents_list_gadt

where "'packed_contents_list" := (packed_contents_list_gadt).

Definition packed_contents_list := 'packed_contents_list.

Parameter of_list : list packed_contents -> packed_contents_list.

Parameter to_list : packed_contents_list -> list packed_contents.

Reserved Notation "'packed_protocol_data".

Inductive packed_protocol_data_gadt : Set :=
| Operation_data : forall {kind : Set},
  protocol_data kind -> packed_protocol_data_gadt

where "'packed_protocol_data" := (packed_protocol_data_gadt).

Definition packed_protocol_data := 'packed_protocol_data.

Module packed_operation.
  Record record := {
    shell : Tezos_protocol_environment_alpha__Environment.Operation.shell_header;
    protocol_data : packed_protocol_data }.
End packed_operation.
Definition packed_operation := packed_operation.record.

Parameter pack : forall {kind : Set}, operation kind -> packed_operation.

Reserved Notation "'packed_internal_operation".

Inductive packed_internal_operation_gadt : Set :=
| Internal_operation : forall {kind : Set},
  internal_operation kind -> packed_internal_operation_gadt

where "'packed_internal_operation" := (packed_internal_operation_gadt).

Definition packed_internal_operation := 'packed_internal_operation.

Parameter manager_kind : forall {kind : Set},
  manager_operation kind -> Kind.manager kind.

Parameter encoding :
  Tezos_protocol_environment_alpha__Environment.Data_encoding.t packed_operation.

Parameter contents_encoding :
  Tezos_protocol_environment_alpha__Environment.Data_encoding.t packed_contents.

Parameter contents_list_encoding :
  Tezos_protocol_environment_alpha__Environment.Data_encoding.t
    packed_contents_list.

Parameter protocol_data_encoding :
  Tezos_protocol_environment_alpha__Environment.Data_encoding.t
    packed_protocol_data.

Parameter unsigned_operation_encoding :
  Tezos_protocol_environment_alpha__Environment.Data_encoding.t
    (Tezos_protocol_environment_alpha__Environment.Operation.shell_header *
      packed_contents_list).

Parameter raw : forall {A : Set}, operation A -> raw.

Parameter hash_raw :
  raw -> Tezos_protocol_environment_alpha__Environment.Operation_hash.t.

Parameter __hash_value : forall {A : Set},
  operation A -> Tezos_protocol_environment_alpha__Environment.Operation_hash.t.

Parameter hash_packed :
  packed_operation ->
  Tezos_protocol_environment_alpha__Environment.Operation_hash.t.

Parameter acceptable_passes : packed_operation -> list Z.

(* extensible_type Tezos_protocol_environment_alpha__Environment.Error_monad.error *)

(* extensible_type Tezos_protocol_environment_alpha__Environment.Error_monad.error *)

Parameter check_signature : forall {A : Set},
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t ->
  Tezos_protocol_environment_alpha__Environment.Chain_id.t -> operation A ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit).

Parameter check_signature_sync : forall {A : Set},
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t ->
  Tezos_protocol_environment_alpha__Environment.Chain_id.t -> operation A ->
  Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit.

Parameter internal_operation_encoding :
  Tezos_protocol_environment_alpha__Environment.Data_encoding.t
    packed_internal_operation.

Reserved Notation "'eq".

Inductive eq_gadt : Set :=
| Eq : eq_gadt

where "'eq" := (fun (a b : Set) => eq_gadt).

Definition eq := 'eq.

Parameter equal : forall {a b : Set},
  operation a -> operation b -> option (eq a b).

Module Encoding.
  Reserved Notation "'case".
  
  Inductive case_gadt : Set :=
  | Case : forall {a b : Set},
    Z -> string ->
    Tezos_protocol_environment_alpha__Environment.Data_encoding.t a ->
    (packed_contents -> option (contents b)) -> (contents b -> a) ->
    (a -> contents b) -> case_gadt
  
  where "'case" := (fun (b : Set) => case_gadt).
  
  Definition case := 'case.
  
  Parameter endorsement_case : case Kind.endorsement.
  
  Parameter seed_nonce_revelation_case : case Kind.seed_nonce_revelation.
  
  Parameter double_endorsement_evidence_case :
    case Kind.double_endorsement_evidence.
  
  Parameter double_baking_evidence_case : case Kind.double_baking_evidence.
  
  Parameter activate_account_case : case Kind.activate_account.
  
  Parameter proposals_case : case Kind.proposals.
  
  Parameter ballot_case : case Kind.ballot.
  
  Parameter reveal_case : case (Kind.manager Kind.reveal).
  
  Parameter transaction_case : case (Kind.manager Kind.transaction).
  
  Parameter origination_case : case (Kind.manager Kind.origination).
  
  Parameter delegation_case : case (Kind.manager Kind.delegation).
  
  Module Manager_operations.
    Reserved Notation "'case".
    
    Inductive case_gadt : Set :=
    | MCase : forall {a kind : Set},
      Z -> string ->
      Tezos_protocol_environment_alpha__Environment.Data_encoding.t a ->
      (packed_manager_operation -> option (manager_operation kind)) ->
      (manager_operation kind -> a) -> (a -> manager_operation kind) ->
      case_gadt
    
    where "'case" := (fun (b : Set) => case_gadt).
    
    Definition case := 'case.
    
    Parameter reveal_case : case Kind.reveal.
    
    Parameter transaction_case : case Kind.transaction.
    
    Parameter origination_case : case Kind.origination.
    
    Parameter delegation_case : case Kind.delegation.
  End Manager_operations.
End Encoding.

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

type bootstrap_account = {
  public_key_hash : Signature.Public_key_hash.t;
  public_key : Signature.Public_key.t option;
  amount : Tez_repr.t;
}

type bootstrap_contract = {
  delegate : Signature.Public_key_hash.t;
  amount : Tez_repr.t;
  script : Script_repr.t;
}

type t = {
  bootstrap_accounts : bootstrap_account list;
  bootstrap_contracts : bootstrap_contract list;
  commitments : Commitment_repr.t list;
  constants : Constants_repr.parametric;
  security_deposit_ramp_up_cycles : int option;
  no_reward_cycles : int option;
}

let bootstrap_account_encoding =
  let open Data_encoding in
  union
    [ case
        (Tag 0)
        ~title:"Public_key_known"
        (tup2 Signature.Public_key.encoding Tez_repr.encoding)
        (function
          | {public_key_hash; public_key = Some public_key; amount} ->
              assert (
                Signature.Public_key_hash.equal
                  (Signature.Public_key.hash public_key)
                  public_key_hash ) ;
              Some (public_key, amount)
          | {public_key = None} ->
              None)
        (fun (public_key, amount) ->
          {
            public_key = Some public_key;
            public_key_hash = Signature.Public_key.hash public_key;
            amount;
          });
      case
        (Tag 1)
        ~title:"Public_key_unknown"
        (tup2 Signature.Public_key_hash.encoding Tez_repr.encoding)
        (function
          | {public_key_hash; public_key = None; amount} ->
              Some (public_key_hash, amount)
          | {public_key = Some _} ->
              None)
        (fun (public_key_hash, amount) ->
          {public_key = None; public_key_hash; amount}) ]

let bootstrap_contract_encoding =
  let open Data_encoding in
  conv
    (fun {delegate; amount; script} -> (delegate, amount, script))
    (fun (delegate, amount, script) -> {delegate; amount; script})
    (obj3
       (req "delegate" Signature.Public_key_hash.encoding)
       (req "amount" Tez_repr.encoding)
       (req "script" Script_repr.encoding))

let encoding =
  let open Data_encoding in
  conv
    (fun { bootstrap_accounts;
           bootstrap_contracts;
           commitments;
           constants;
           security_deposit_ramp_up_cycles;
           no_reward_cycles } ->
      ( ( bootstrap_accounts,
          bootstrap_contracts,
          commitments,
          security_deposit_ramp_up_cycles,
          no_reward_cycles ),
        constants ))
    (fun ( ( bootstrap_accounts,
             bootstrap_contracts,
             commitments,
             security_deposit_ramp_up_cycles,
             no_reward_cycles ),
           constants ) ->
      {
        bootstrap_accounts;
        bootstrap_contracts;
        commitments;
        constants;
        security_deposit_ramp_up_cycles;
        no_reward_cycles;
      })
    (merge_objs
       (obj5
          (req "bootstrap_accounts" (list bootstrap_account_encoding))
          (dft "bootstrap_contracts" (list bootstrap_contract_encoding) [])
          (dft "commitments" (list Commitment_repr.encoding) [])
          (opt "security_deposit_ramp_up_cycles" int31)
          (opt "no_reward_cycles" int31))
       Constants_repr.parametric_encoding)

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Module bootstrap_account.
  Record record := {
    public_key_hash :
      Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t;
    public_key :
      option
        Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t;
    amount : Tezos_raw_protocol_alpha.Tez_repr.t }.
End bootstrap_account.
Definition bootstrap_account := bootstrap_account.record.

Module bootstrap_contract.
  Record record := {
    delegate :
      Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t;
    amount : Tezos_raw_protocol_alpha.Tez_repr.t;
    script : Tezos_raw_protocol_alpha.Script_repr.t }.
End bootstrap_contract.
Definition bootstrap_contract := bootstrap_contract.record.

Module t.
  Record record := {
    bootstrap_accounts : list bootstrap_account;
    bootstrap_contracts : list bootstrap_contract;
    commitments : list Tezos_raw_protocol_alpha.Commitment_repr.t;
    constants : Tezos_raw_protocol_alpha.Constants_repr.parametric;
    security_deposit_ramp_up_cycles : option Z;
    no_reward_cycles : option Z }.
End t.
Definition t := t.record.

Definition bootstrap_account_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    bootstrap_account :=
  union None
    (cons
      (__case_value "Public_key_known" % string None
        (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag 0)
        (tup2 Signature.Public_key.encoding Tez_repr.encoding)
        (fun function_parameter =>
          match function_parameter with
          | {|
            bootstrap_account.public_key_hash := public_key_hash;
              bootstrap_account.public_key := Some public_key;
              bootstrap_account.amount := amount
              |} =>
            (* ❌ Sequences of instructions are not handled (operator ";") *)
            let _ :=
              (* ❌ Assert instruction is not handled. *)
              assert
                (Signature.Public_key_hash.equal
                  (Signature.Public_key.__hash_value public_key) public_key_hash)
              in
            Some (public_key, amount)
          | {| bootstrap_account.public_key := None |} => None
          end)
        (fun function_parameter =>
          let '(public_key, amount) := function_parameter in
          {|
            bootstrap_account.public_key_hash :=
              Signature.Public_key.__hash_value public_key;
            bootstrap_account.public_key := Some public_key;
            bootstrap_account.amount := amount |}))
      (cons
        (__case_value "Public_key_unknown" % string None
          (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag 1)
          (tup2 Signature.Public_key_hash.encoding Tez_repr.encoding)
          (fun function_parameter =>
            match function_parameter with
            | {|
              bootstrap_account.public_key_hash := public_key_hash;
                bootstrap_account.public_key := None;
                bootstrap_account.amount := amount
                |} => Some (public_key_hash, amount)
            | {| bootstrap_account.public_key := Some _ |} => None
            end)
          (fun function_parameter =>
            let '(public_key_hash, amount) := function_parameter in
            {| bootstrap_account.public_key_hash := public_key_hash;
              bootstrap_account.public_key := None;
              bootstrap_account.amount := amount |})) [])).

Definition bootstrap_contract_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    bootstrap_contract :=
  conv
    (fun function_parameter =>
      let '{|
        bootstrap_contract.delegate := delegate;
          bootstrap_contract.amount := amount;
          bootstrap_contract.script := script
          |} := function_parameter in
      (delegate, amount, script))
    (fun function_parameter =>
      let '(delegate, amount, script) := function_parameter in
      {| bootstrap_contract.delegate := delegate;
        bootstrap_contract.amount := amount; bootstrap_contract.script := script
        |}) None
    (obj3 (req None None "delegate" % string Signature.Public_key_hash.encoding)
      (req None None "amount" % string Tez_repr.encoding)
      (req None None "script" % string Script_repr.encoding)).

Definition encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding t :=
  conv
    (fun function_parameter =>
      let '{|
        t.bootstrap_accounts := bootstrap_accounts;
          t.bootstrap_contracts := bootstrap_contracts;
          t.commitments := commitments;
          t.constants := constants;
          t.security_deposit_ramp_up_cycles := security_deposit_ramp_up_cycles;
          t.no_reward_cycles := no_reward_cycles
          |} := function_parameter in
      ((bootstrap_accounts, bootstrap_contracts, commitments,
        security_deposit_ramp_up_cycles, no_reward_cycles), constants))
    (fun function_parameter =>
      let
        '((bootstrap_accounts, bootstrap_contracts, commitments,
          security_deposit_ramp_up_cycles, no_reward_cycles), constants) :=
        function_parameter in
      {| t.bootstrap_accounts := bootstrap_accounts;
        t.bootstrap_contracts := bootstrap_contracts;
        t.commitments := commitments; t.constants := constants;
        t.security_deposit_ramp_up_cycles := security_deposit_ramp_up_cycles;
        t.no_reward_cycles := no_reward_cycles |}) None
    (merge_objs
      (obj5
        (req None None "bootstrap_accounts" % string
          (__list_value None bootstrap_account_encoding))
        (dft None None "bootstrap_contracts" % string
          (__list_value None bootstrap_contract_encoding) [])
        (dft None None "commitments" % string
          (__list_value None Commitment_repr.encoding) [])
        (opt None None "security_deposit_ramp_up_cycles" % string int31)
        (opt None None "no_reward_cycles" % string int31))
      Constants_repr.parametric_encoding).

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

type bootstrap_account = {
  public_key_hash : Signature.Public_key_hash.t;
  public_key : Signature.Public_key.t option;
  amount : Tez_repr.t;
}

type bootstrap_contract = {
  delegate : Signature.Public_key_hash.t;
  amount : Tez_repr.t;
  script : Script_repr.t;
}

type t = {
  bootstrap_accounts : bootstrap_account list;
  bootstrap_contracts : bootstrap_contract list;
  commitments : Commitment_repr.t list;
  constants : Constants_repr.parametric;
  security_deposit_ramp_up_cycles : int option;
  no_reward_cycles : int option;
}

val encoding : t Data_encoding.t

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Module bootstrap_account.
  Record record := {
    public_key_hash :
      Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t;
    public_key :
      option
        Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t;
    amount : Tezos_raw_protocol_alpha.Tez_repr.t }.
End bootstrap_account.
Definition bootstrap_account := bootstrap_account.record.

Module bootstrap_contract.
  Record record := {
    delegate :
      Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t;
    amount : Tezos_raw_protocol_alpha.Tez_repr.t;
    script : Tezos_raw_protocol_alpha.Script_repr.t }.
End bootstrap_contract.
Definition bootstrap_contract := bootstrap_contract.record.

Module t.
  Record record := {
    bootstrap_accounts : list bootstrap_account;
    bootstrap_contracts : list bootstrap_contract;
    commitments : list Tezos_raw_protocol_alpha.Commitment_repr.t;
    constants : Tezos_raw_protocol_alpha.Constants_repr.parametric;
    security_deposit_ramp_up_cycles : option Z;
    no_reward_cycles : option Z }.
End t.
Definition t := t.record.

Parameter encoding :
  Tezos_protocol_environment_alpha__Environment.Data_encoding.t t.

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

type t = Int64.t

type period = t

include (Compare.Int64 : Compare.S with type t := t)

let encoding = Data_encoding.int64

let rpc_arg = RPC_arg.int64

let pp ppf v = Format.fprintf ppf "%Ld" v

type error += (* `Permanent *)
                Malformed_period | Invalid_arg

let () =
  let open Data_encoding in
  (* Malformed period *)
  register_error_kind
    `Permanent
    ~id:"malformed_period"
    ~title:"Malformed period"
    ~description:"Period is negative."
    ~pp:(fun ppf () -> Format.fprintf ppf "Malformed period")
    empty
    (function Malformed_period -> Some () | _ -> None)
    (fun () -> Malformed_period) ;
  (* Invalid arg *)
  register_error_kind
    `Permanent
    ~id:"invalid_arg"
    ~title:"Invalid arg"
    ~description:"Negative multiple of periods are not allowed."
    ~pp:(fun ppf () -> Format.fprintf ppf "Invalid arg")
    empty
    (function Invalid_arg -> Some () | _ -> None)
    (fun () -> Invalid_arg)

let of_seconds t =
  if Compare.Int64.(t >= 0L) then ok t else error Malformed_period

let to_seconds t = t

let of_seconds_exn t =
  match of_seconds t with
  | Ok t ->
      t
  | _ ->
      invalid_arg "Period.of_seconds_exn"

let mult i p =
  (* TODO check overflow *)
  if Compare.Int32.(i < 0l) then error Invalid_arg
  else ok (Int64.mul (Int64.of_int32 i) p)

let zero = of_seconds_exn 0L

let one_second = of_seconds_exn 1L

let one_minute = of_seconds_exn 60L

let one_hour = of_seconds_exn 3600L

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Definition t := Tezos_protocol_environment_alpha__Environment.Int64.t.

Definition period := t.

Export Compare.Int64.

Definition encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding int64 :=
  Data_encoding.__int64_value.

Definition rpc_arg
  : Tezos_protocol_environment_alpha__Environment.RPC_arg.arg int64 :=
  RPC_arg.__int64_value.

Definition pp
  (ppf : Tezos_protocol_environment_alpha__Environment.Format.formatter)
  (v : int64) : unit :=
  Format.fprintf ppf
    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int64
        Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int_d
        Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
        Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_precision
        Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
      "%Ld" % string) v.

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Top-level evaluations are considered as an error as sources of side-effects *)
Compute
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "malformed_period" % string "Malformed period" % string
      "Period is negative." % string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let 'tt := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Malformed period" % string
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
                "Malformed period" % string))) empty
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Malformed_period
          => Some tt
        | _ => None
        end)
      (fun function_parameter =>
        let 'tt := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Malformed_period)
    in
  register_error_kind
    (* ❌ Variants not supported *)
    variant "invalid_arg" % string "Invalid arg" % string
    "Negative multiple of periods are not allowed." % string
    (Some
      (fun ppf =>
        fun function_parameter =>
          let 'tt := function_parameter in
          Format.fprintf ppf
            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                "Invalid arg" % string
                Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
              "Invalid arg" % string))) empty
    (fun function_parameter =>
      match function_parameter with
      | Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_arg =>
        Some tt
      | _ => None
      end)
    (fun function_parameter =>
      let 'tt := function_parameter in
      Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_arg).

Definition of_seconds
  (t : Tezos_protocol_environment_alpha__Environment.Compare.Int64.t)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    Tezos_protocol_environment_alpha__Environment.Compare.Int64.t :=
  if
    op_gteq t
      (* ❌ Constant of type int64 is converted to int *)
      0 then
    ok t
  else
    __error_value
      Tezos_protocol_environment_alpha__Environment.Error_monad.Malformed_period.

Definition to_seconds {A : Set} (t : A) : A := t.

Definition of_seconds_exn
  (t : Tezos_protocol_environment_alpha__Environment.Compare.Int64.t)
  : Tezos_protocol_environment_alpha__Environment.Compare.Int64.t :=
  match of_seconds t with
  | Tezos_protocol_environment_alpha__Environment.Pervasives.Ok t => t
  | _ => invalid_arg "Period.of_seconds_exn" % string
  end.

Definition mult
  (i : Tezos_protocol_environment_alpha__Environment.Compare.Int32.t)
  (p : int64)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult int64 :=
  if
    op_lt i
      (* ❌ Constant of type int32 is converted to int *)
      0 then
    __error_value
      Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_arg
  else
    ok (Int64.mul (Int64.of_int32 i) p).

Definition zero
  : Tezos_protocol_environment_alpha__Environment.Compare.Int64.t :=
  of_seconds_exn
    (* ❌ Constant of type int64 is converted to int *)
    0.

Definition one_second
  : Tezos_protocol_environment_alpha__Environment.Compare.Int64.t :=
  of_seconds_exn
    (* ❌ Constant of type int64 is converted to int *)
    1.

Definition one_minute
  : Tezos_protocol_environment_alpha__Environment.Compare.Int64.t :=
  of_seconds_exn
    (* ❌ Constant of type int64 is converted to int *)
    60.

Definition one_hour
  : Tezos_protocol_environment_alpha__Environment.Compare.Int64.t :=
  of_seconds_exn
    (* ❌ Constant of type int64 is converted to int *)
    3600.

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

type t

type period = t

include Compare.S with type t := t

val encoding : period Data_encoding.t

val rpc_arg : period RPC_arg.t

val pp : Format.formatter -> period -> unit

val to_seconds : period -> int64

(** [of_second period] fails if period is not positive *)
val of_seconds : int64 -> period tzresult

(** [of_second period] fails if period is not positive.
    It should only be used at toplevel for constants. *)
val of_seconds_exn : int64 -> period

val mult : int32 -> period -> period tzresult

val zero : period

val one_second : period

val one_minute : period

val one_hour : period

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Parameter t : Set.

Definition period := t.

Parameter op_eq : t -> t -> bool.

Parameter op_ltgt : t -> t -> bool.

Parameter op_lt : t -> t -> bool.

Parameter op_lteq : t -> t -> bool.

Parameter op_gteq : t -> t -> bool.

Parameter op_gt : t -> t -> bool.

Parameter compare : t -> t -> Z.

Parameter equal : t -> t -> bool.

Parameter max : t -> t -> t.

Parameter min : t -> t -> t.

Parameter encoding :
  Tezos_protocol_environment_alpha__Environment.Data_encoding.t period.

Parameter rpc_arg :
  Tezos_protocol_environment_alpha__Environment.RPC_arg.t period.

Parameter pp :
  Tezos_protocol_environment_alpha__Environment.Format.formatter -> period ->
  unit.

Parameter to_seconds : period -> int64.

Parameter of_seconds :
  int64 ->
  Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult period.

Parameter of_seconds_exn : int64 -> period.

Parameter mult :
  int32 -> period ->
  Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult period.

Parameter zero : period.

Parameter one_second : period.

Parameter one_minute : period.

Parameter one_hour : period.

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

module type QTY = sig
  val id : string
end

module type S = sig
  type qty

  type error +=
    | Addition_overflow of qty * qty (* `Temporary *)
    | Subtraction_underflow of qty * qty (* `Temporary *)
    | Multiplication_overflow of qty * int64 (* `Temporary *)
    | Negative_multiplicator of qty * int64 (* `Temporary *)
    | Invalid_divisor of qty * int64

  (* `Temporary *)

  val id : string

  val zero : qty

  val one_mutez : qty

  val one_cent : qty

  val fifty_cents : qty

  val one : qty

  val ( -? ) : qty -> qty -> qty tzresult

  val ( +? ) : qty -> qty -> qty tzresult

  val ( *? ) : qty -> int64 -> qty tzresult

  val ( /? ) : qty -> int64 -> qty tzresult

  val to_mutez : qty -> int64

  (** [of_mutez n] (micro tez) is None if n is negative *)
  val of_mutez : int64 -> qty option

  (** [of_mutez_exn n] fails if n is negative.
      It should only be used at toplevel for constants. *)
  val of_mutez_exn : int64 -> qty

  (** It should only be used at toplevel for constants. *)
  val add_exn : qty -> qty -> qty

  (** It should only be used at toplevel for constants. *)
  val mul_exn : qty -> int -> qty

  val encoding : qty Data_encoding.t

  val to_int64 : qty -> int64

  include Compare.S with type t := qty

  val pp : Format.formatter -> qty -> unit

  val of_string : string -> qty option

  val to_string : qty -> string
end

module Make (T : QTY) : S = struct
  type qty = int64 (* invariant: positive *)

  type error +=
    | Addition_overflow of qty * qty (* `Temporary *)
    | Subtraction_underflow of qty * qty (* `Temporary *)
    | Multiplication_overflow of qty * int64 (* `Temporary *)
    | Negative_multiplicator of qty * int64 (* `Temporary *)
    | Invalid_divisor of qty * int64

  (* `Temporary *)

  include Compare.Int64

  let zero = 0L

  (* all other constant are defined from the value of one micro tez *)
  let one_mutez = 1L

  let one_cent = Int64.mul one_mutez 10_000L

  let fifty_cents = Int64.mul one_cent 50L

  (* 1 tez = 100 cents = 1_000_000 mutez *)
  let one = Int64.mul one_cent 100L

  let id = T.id

  let of_string s =
    let triplets = function
      | hd :: tl ->
          let len = String.length hd in
          Compare.Int.(
            len <= 3 && len > 0
            && List.for_all (fun s -> String.length s = 3) tl)
      | [] ->
          false
    in
    let integers s = triplets (String.split_on_char ',' s) in
    let decimals s =
      let l = String.split_on_char ',' s in
      if Compare.Int.(List.length l > 2) then false else triplets (List.rev l)
    in
    let parse left right =
      let remove_commas s = String.concat "" (String.split_on_char ',' s) in
      let pad_to_six s =
        let len = String.length s in
        String.init 6 (fun i -> if Compare.Int.(i < len) then s.[i] else '0')
      in
      try
        Some
          (Int64.of_string
             (remove_commas left ^ pad_to_six (remove_commas right)))
      with _ -> None
    in
    match String.split_on_char '.' s with
    | [left; right] ->
        if String.contains s ',' then
          if integers left && decimals right then parse left right else None
        else if
          Compare.Int.(String.length right > 0)
          && Compare.Int.(String.length right <= 6)
        then parse left right
        else None
    | [left] ->
        if (not (String.contains s ',')) || integers left then parse left ""
        else None
    | _ ->
        None

  let pp ppf amount =
    let mult_int = 1_000_000L in
    let rec left ppf amount =
      let (d, r) = (Int64.(div amount 1000L), Int64.(rem amount 1000L)) in
      if d > 0L then Format.fprintf ppf "%a%03Ld" left d r
      else Format.fprintf ppf "%Ld" r
    in
    let right ppf amount =
      let triplet ppf v =
        if Compare.Int.(v mod 10 > 0) then Format.fprintf ppf "%03d" v
        else if Compare.Int.(v mod 100 > 0) then
          Format.fprintf ppf "%02d" (v / 10)
        else Format.fprintf ppf "%d" (v / 100)
      in
      let (hi, lo) = (amount / 1000, amount mod 1000) in
      if Compare.Int.(lo = 0) then Format.fprintf ppf "%a" triplet hi
      else Format.fprintf ppf "%03d%a" hi triplet lo
    in
    let (ints, decs) =
      (Int64.(div amount mult_int), Int64.(to_int (rem amount mult_int)))
    in
    Format.fprintf ppf "%a" left ints ;
    if Compare.Int.(decs > 0) then Format.fprintf ppf ".%a" right decs

  let to_string t = Format.asprintf "%a" pp t

  let ( - ) t1 t2 = if t2 <= t1 then Some (Int64.sub t1 t2) else None

  let ( -? ) t1 t2 =
    match t1 - t2 with
    | None ->
        error (Subtraction_underflow (t1, t2))
    | Some v ->
        ok v

  let ( +? ) t1 t2 =
    let t = Int64.add t1 t2 in
    if t < t1 then error (Addition_overflow (t1, t2)) else ok t

  let ( *? ) t m =
    let open Compare.Int64 in
    let open Int64 in
    let rec step cur pow acc =
      if cur = 0L then ok acc
      else
        pow +? pow
        >>? fun npow ->
        if logand cur 1L = 1L then
          acc +? pow >>? fun nacc -> step (shift_right_logical cur 1) npow nacc
        else step (shift_right_logical cur 1) npow acc
    in
    if m < 0L then error (Negative_multiplicator (t, m))
    else
      match step m t 0L with
      | Ok res ->
          Ok res
      | Error ([Addition_overflow _] as errs) ->
          Error (Multiplication_overflow (t, m) :: errs)
      | Error errs ->
          Error errs

  let ( /? ) t d =
    if d <= 0L then error (Invalid_divisor (t, d)) else ok (Int64.div t d)

  let add_exn t1 t2 =
    let t = Int64.add t1 t2 in
    if t <= 0L then invalid_arg "add_exn" else t

  let mul_exn t m =
    match t *? Int64.(of_int m) with
    | Ok v ->
        v
    | Error _ ->
        invalid_arg "mul_exn"

  let of_mutez t = if t < 0L then None else Some t

  let of_mutez_exn x =
    match of_mutez x with None -> invalid_arg "Qty.of_mutez" | Some v -> v

  let to_int64 t = t

  let to_mutez t = t

  let encoding =
    let open Data_encoding in
    check_size 10 (conv Z.of_int64 (Json.wrap_error Z.to_int64) n)

  let () =
    let open Data_encoding in
    register_error_kind
      `Temporary
      ~id:(T.id ^ ".addition_overflow")
      ~title:("Overflowing " ^ T.id ^ " addition")
      ~pp:(fun ppf (opa, opb) ->
        Format.fprintf
          ppf
          "Overflowing addition of %a %s and %a %s"
          pp
          opa
          T.id
          pp
          opb
          T.id)
      ~description:("An addition of two " ^ T.id ^ " amounts overflowed")
      (obj1 (req "amounts" (tup2 encoding encoding)))
      (function Addition_overflow (a, b) -> Some (a, b) | _ -> None)
      (fun (a, b) -> Addition_overflow (a, b)) ;
    register_error_kind
      `Temporary
      ~id:(T.id ^ ".subtraction_underflow")
      ~title:("Underflowing " ^ T.id ^ " subtraction")
      ~pp:(fun ppf (opa, opb) ->
        Format.fprintf
          ppf
          "Underflowing subtraction of %a %s and %a %s"
          pp
          opa
          T.id
          pp
          opb
          T.id)
      ~description:("An subtraction of two " ^ T.id ^ " amounts underflowed")
      (obj1 (req "amounts" (tup2 encoding encoding)))
      (function Subtraction_underflow (a, b) -> Some (a, b) | _ -> None)
      (fun (a, b) -> Subtraction_underflow (a, b)) ;
    register_error_kind
      `Temporary
      ~id:(T.id ^ ".multiplication_overflow")
      ~title:("Overflowing " ^ T.id ^ " multiplication")
      ~pp:(fun ppf (opa, opb) ->
        Format.fprintf
          ppf
          "Overflowing multiplication of %a %s and %Ld"
          pp
          opa
          T.id
          opb)
      ~description:
        ("A multiplication of a " ^ T.id ^ " amount by an integer overflowed")
      (obj2 (req "amount" encoding) (req "multiplicator" int64))
      (function Multiplication_overflow (a, b) -> Some (a, b) | _ -> None)
      (fun (a, b) -> Multiplication_overflow (a, b)) ;
    register_error_kind
      `Temporary
      ~id:(T.id ^ ".negative_multiplicator")
      ~title:("Negative " ^ T.id ^ " multiplicator")
      ~pp:(fun ppf (opa, opb) ->
        Format.fprintf
          ppf
          "Multiplication of %a %s by negative integer %Ld"
          pp
          opa
          T.id
          opb)
      ~description:
        ("Multiplication of a " ^ T.id ^ " amount by a negative integer")
      (obj2 (req "amount" encoding) (req "multiplicator" int64))
      (function Negative_multiplicator (a, b) -> Some (a, b) | _ -> None)
      (fun (a, b) -> Negative_multiplicator (a, b)) ;
    register_error_kind
      `Temporary
      ~id:(T.id ^ ".invalid_divisor")
      ~title:("Invalid " ^ T.id ^ " divisor")
      ~pp:(fun ppf (opa, opb) ->
        Format.fprintf
          ppf
          "Division of %a %s by non positive integer %Ld"
          pp
          opa
          T.id
          opb)
      ~description:
        ("Multiplication of a " ^ T.id ^ " amount by a non positive integer")
      (obj2 (req "amount" encoding) (req "divisor" int64))
      (function Invalid_divisor (a, b) -> Some (a, b) | _ -> None)
      (fun (a, b) -> Invalid_divisor (a, b))
end

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Module QTY.
  Record signature := {
    id : string;
  }.
End QTY.

Module S.
  Record signature {qty : Set} := {
    qty := qty;
    (* extensible_type Tezos_protocol_environment_alpha__Environment.Error_monad.error *)
    id : string;
    zero : qty;
    one_mutez : qty;
    one_cent : qty;
    fifty_cents : qty;
    one : qty;
    op_minusquestion :
      qty -> qty ->
      Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult qty;
    op_plusquestion :
      qty -> qty ->
      Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult qty;
    op_starquestion :
      qty -> int64 ->
      Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult qty;
    op_divquestion :
      qty -> int64 ->
      Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult qty;
    to_mutez : qty -> int64;
    of_mutez : int64 -> option qty;
    of_mutez_exn : int64 -> qty;
    add_exn : qty -> qty -> qty;
    mul_exn : qty -> Z -> qty;
    encoding :
      Tezos_protocol_environment_alpha__Environment.Data_encoding.t qty;
    to_int64 : qty -> int64;
    op_eq : qty -> qty -> bool;
    op_ltgt : qty -> qty -> bool;
    op_lt : qty -> qty -> bool;
    op_lteq : qty -> qty -> bool;
    op_gteq : qty -> qty -> bool;
    op_gt : qty -> qty -> bool;
    compare : qty -> qty -> Z;
    equal : qty -> qty -> bool;
    max : qty -> qty -> qty;
    min : qty -> qty -> qty;
    pp :
      Tezos_protocol_environment_alpha__Environment.Format.formatter -> qty ->
      unit;
    of_string : string -> option qty;
    to_string : qty -> string;
  }.
  Arguments signature : clear implicits.
End S.

(* ❌ Functors are not handled. *)
functor

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

module Int_set = Set.Make (Compare.Int)

type t = {
  context : Context.t;
  constants : Constants_repr.parametric;
  first_level : Raw_level_repr.t;
  level : Level_repr.t;
  predecessor_timestamp : Time.t;
  timestamp : Time.t;
  fitness : Int64.t;
  deposits : Tez_repr.t Signature.Public_key_hash.Map.t;
  included_endorsements : int;
  allowed_endorsements :
    (Signature.Public_key.t * int list * bool) Signature.Public_key_hash.Map.t;
  fees : Tez_repr.t;
  rewards : Tez_repr.t;
  block_gas : Z.t;
  operation_gas : Gas_limit_repr.t;
  internal_gas : Gas_limit_repr.internal_gas;
  storage_space_to_pay : Z.t option;
  allocated_contracts : int option;
  origination_nonce : Contract_repr.origination_nonce option;
  temporary_big_map : Z.t;
  internal_nonce : int;
  internal_nonces_used : Int_set.t;
}

type context = t

type root_context = t

let current_level ctxt = ctxt.level

let predecessor_timestamp ctxt = ctxt.predecessor_timestamp

let current_timestamp ctxt = ctxt.timestamp

let current_fitness ctxt = ctxt.fitness

let first_level ctxt = ctxt.first_level

let constants ctxt = ctxt.constants

let recover ctxt = ctxt.context

let record_endorsement ctxt k =
  match Signature.Public_key_hash.Map.find_opt k ctxt.allowed_endorsements with
  | None ->
      assert false
  | Some (_, _, true) ->
      assert false (* right already used *)
  | Some (d, s, false) ->
      {
        ctxt with
        included_endorsements = ctxt.included_endorsements + List.length s;
        allowed_endorsements =
          Signature.Public_key_hash.Map.add
            k
            (d, s, true)
            ctxt.allowed_endorsements;
      }

let init_endorsements ctxt allowed_endorsements =
  if Signature.Public_key_hash.Map.is_empty allowed_endorsements then
    assert false (* can't initialize to empty *)
  else if Signature.Public_key_hash.Map.is_empty ctxt.allowed_endorsements then
    {ctxt with allowed_endorsements}
  else assert false

(* can't initialize twice *)

let allowed_endorsements ctxt = ctxt.allowed_endorsements

let included_endorsements ctxt = ctxt.included_endorsements

type error += Too_many_internal_operations (* `Permanent *)

let () =
  let open Data_encoding in
  register_error_kind
    `Permanent
    ~id:"too_many_internal_operations"
    ~title:"Too many internal operations"
    ~description:
      "A transaction exceeded the hard limit of internal operations it can emit"
    empty
    (function Too_many_internal_operations -> Some () | _ -> None)
    (fun () -> Too_many_internal_operations)

let fresh_internal_nonce ctxt =
  if Compare.Int.(ctxt.internal_nonce >= 65_535) then
    error Too_many_internal_operations
  else
    ok
      ( {ctxt with internal_nonce = ctxt.internal_nonce + 1},
        ctxt.internal_nonce )

let reset_internal_nonce ctxt =
  {ctxt with internal_nonces_used = Int_set.empty; internal_nonce = 0}

let record_internal_nonce ctxt k =
  {ctxt with internal_nonces_used = Int_set.add k ctxt.internal_nonces_used}

let internal_nonce_already_recorded ctxt k =
  Int_set.mem k ctxt.internal_nonces_used

let set_current_fitness ctxt fitness = {ctxt with fitness}

let add_fees ctxt fees =
  Lwt.return Tez_repr.(ctxt.fees +? fees)
  >>=? fun fees -> return {ctxt with fees}

let add_rewards ctxt rewards =
  Lwt.return Tez_repr.(ctxt.rewards +? rewards)
  >>=? fun rewards -> return {ctxt with rewards}

let add_deposit ctxt delegate deposit =
  let previous =
    match Signature.Public_key_hash.Map.find_opt delegate ctxt.deposits with
    | Some tz ->
        tz
    | None ->
        Tez_repr.zero
  in
  Lwt.return Tez_repr.(previous +? deposit)
  >>=? fun deposit ->
  let deposits =
    Signature.Public_key_hash.Map.add delegate deposit ctxt.deposits
  in
  return {ctxt with deposits}

let get_deposits ctxt = ctxt.deposits

let get_rewards ctxt = ctxt.rewards

let get_fees ctxt = ctxt.fees

type error += Undefined_operation_nonce (* `Permanent *)

let () =
  let open Data_encoding in
  register_error_kind
    `Permanent
    ~id:"undefined_operation_nonce"
    ~title:"Ill timed access to the origination nonce"
    ~description:
      "An origination was attemped out of the scope of a manager operation"
    empty
    (function Undefined_operation_nonce -> Some () | _ -> None)
    (fun () -> Undefined_operation_nonce)

let init_origination_nonce ctxt operation_hash =
  let origination_nonce =
    Some (Contract_repr.initial_origination_nonce operation_hash)
  in
  {ctxt with origination_nonce}

let origination_nonce ctxt =
  match ctxt.origination_nonce with
  | None ->
      error Undefined_operation_nonce
  | Some origination_nonce ->
      ok origination_nonce

let increment_origination_nonce ctxt =
  match ctxt.origination_nonce with
  | None ->
      error Undefined_operation_nonce
  | Some cur_origination_nonce ->
      let origination_nonce =
        Some (Contract_repr.incr_origination_nonce cur_origination_nonce)
      in
      ok ({ctxt with origination_nonce}, cur_origination_nonce)

let unset_origination_nonce ctxt = {ctxt with origination_nonce = None}

type error += Gas_limit_too_high (* `Permanent *)

let () =
  let open Data_encoding in
  register_error_kind
    `Permanent
    ~id:"gas_limit_too_high"
    ~title:"Gas limit out of protocol hard bounds"
    ~description:"A transaction tried to exceed the hard limit on gas"
    empty
    (function Gas_limit_too_high -> Some () | _ -> None)
    (fun () -> Gas_limit_too_high)

let check_gas_limit ctxt remaining =
  if
    Compare.Z.(remaining > ctxt.constants.hard_gas_limit_per_operation)
    || Compare.Z.(remaining < Z.zero)
  then error Gas_limit_too_high
  else ok ()

let set_gas_limit ctxt remaining =
  {
    ctxt with
    operation_gas = Limited {remaining};
    internal_gas = Gas_limit_repr.internal_gas_zero;
  }

let set_gas_unlimited ctxt = {ctxt with operation_gas = Unaccounted}

let consume_gas ctxt cost =
  Gas_limit_repr.consume
    ctxt.block_gas
    ctxt.operation_gas
    ctxt.internal_gas
    cost
  >>? fun (block_gas, operation_gas, internal_gas) ->
  ok {ctxt with block_gas; operation_gas; internal_gas}

let check_enough_gas ctxt cost =
  Gas_limit_repr.check_enough
    ctxt.block_gas
    ctxt.operation_gas
    ctxt.internal_gas
    cost

let gas_level ctxt = ctxt.operation_gas

let block_gas_level ctxt = ctxt.block_gas

let gas_consumed ~since ~until =
  match (gas_level since, gas_level until) with
  | (Limited {remaining = before}, Limited {remaining = after}) ->
      Z.sub before after
  | (_, _) ->
      Z.zero

let init_storage_space_to_pay ctxt =
  match ctxt.storage_space_to_pay with
  | Some _ ->
      assert false
  | None ->
      {
        ctxt with
        storage_space_to_pay = Some Z.zero;
        allocated_contracts = Some 0;
      }

let update_storage_space_to_pay ctxt n =
  match ctxt.storage_space_to_pay with
  | None ->
      assert false
  | Some storage_space_to_pay ->
      {ctxt with storage_space_to_pay = Some (Z.add n storage_space_to_pay)}

let update_allocated_contracts_count ctxt =
  match ctxt.allocated_contracts with
  | None ->
      assert false
  | Some allocated_contracts ->
      {ctxt with allocated_contracts = Some (succ allocated_contracts)}

let clear_storage_space_to_pay ctxt =
  match (ctxt.storage_space_to_pay, ctxt.allocated_contracts) with
  | (None, _) | (_, None) ->
      assert false
  | (Some storage_space_to_pay, Some allocated_contracts) ->
      ( {ctxt with storage_space_to_pay = None; allocated_contracts = None},
        storage_space_to_pay,
        allocated_contracts )

type storage_error =
  | Incompatible_protocol_version of string
  | Missing_key of string list * [`Get | `Set | `Del | `Copy]
  | Existing_key of string list
  | Corrupted_data of string list

let storage_error_encoding =
  let open Data_encoding in
  union
    [ case
        (Tag 0)
        ~title:"Incompatible_protocol_version"
        (obj1 (req "incompatible_protocol_version" string))
        (function Incompatible_protocol_version arg -> Some arg | _ -> None)
        (fun arg -> Incompatible_protocol_version arg);
      case
        (Tag 1)
        ~title:"Missing_key"
        (obj2
           (req "missing_key" (list string))
           (req
              "function"
              (string_enum
                 [("get", `Get); ("set", `Set); ("del", `Del); ("copy", `Copy)])))
        (function Missing_key (key, f) -> Some (key, f) | _ -> None)
        (fun (key, f) -> Missing_key (key, f));
      case
        (Tag 2)
        ~title:"Existing_key"
        (obj1 (req "existing_key" (list string)))
        (function Existing_key key -> Some key | _ -> None)
        (fun key -> Existing_key key);
      case
        (Tag 3)
        ~title:"Corrupted_data"
        (obj1 (req "corrupted_data" (list string)))
        (function Corrupted_data key -> Some key | _ -> None)
        (fun key -> Corrupted_data key) ]

let pp_storage_error ppf = function
  | Incompatible_protocol_version version ->
      Format.fprintf
        ppf
        "Found a context with an unexpected version '%s'."
        version
  | Missing_key (key, `Get) ->
      Format.fprintf ppf "Missing key '%s'." (String.concat "/" key)
  | Missing_key (key, `Set) ->
      Format.fprintf
        ppf
        "Cannot set undefined key '%s'."
        (String.concat "/" key)
  | Missing_key (key, `Del) ->
      Format.fprintf
        ppf
        "Cannot delete undefined key '%s'."
        (String.concat "/" key)
  | Missing_key (key, `Copy) ->
      Format.fprintf
        ppf
        "Cannot copy undefined key '%s'."
        (String.concat "/" key)
  | Existing_key key ->
      Format.fprintf
        ppf
        "Cannot initialize defined key '%s'."
        (String.concat "/" key)
  | Corrupted_data key ->
      Format.fprintf
        ppf
        "Failed to parse the data at '%s'."
        (String.concat "/" key)

type error += Storage_error of storage_error

let () =
  register_error_kind
    `Permanent
    ~id:"context.storage_error"
    ~title:"Storage error (fatal internal error)"
    ~description:
      "An error that should never happen unless something has been deleted or \
       corrupted in the database."
    ~pp:(fun ppf err ->
      Format.fprintf ppf "@[<v 2>Storage error:@ %a@]" pp_storage_error err)
    storage_error_encoding
    (function Storage_error err -> Some err | _ -> None)
    (fun err -> Storage_error err)

let storage_error err = fail (Storage_error err)

(* Initialization *********************************************************)

(* This key should always be populated for every version of the
   protocol.  It's absence meaning that the context is empty. *)
let version_key = ["version"]

let version_value = "alpha_current"

let version = "v1"

let first_level_key = [version; "first_level"]

let constants_key = [version; "constants"]

let protocol_param_key = ["protocol_parameters"]

let get_first_level ctxt =
  Context.get ctxt first_level_key
  >>= function
  | None ->
      storage_error (Missing_key (first_level_key, `Get))
  | Some bytes -> (
    match Data_encoding.Binary.of_bytes Raw_level_repr.encoding bytes with
    | None ->
        storage_error (Corrupted_data first_level_key)
    | Some level ->
        return level )

let set_first_level ctxt level =
  let bytes =
    Data_encoding.Binary.to_bytes_exn Raw_level_repr.encoding level
  in
  Context.set ctxt first_level_key bytes >>= fun ctxt -> return ctxt

type error += Failed_to_parse_parameter of MBytes.t

type error += Failed_to_decode_parameter of Data_encoding.json * string

let () =
  register_error_kind
    `Temporary
    ~id:"context.failed_to_parse_parameter"
    ~title:"Failed to parse parameter"
    ~description:"The protocol parameters are not valid JSON."
    ~pp:(fun ppf bytes ->
      Format.fprintf
        ppf
        "@[<v 2>Cannot parse the protocol parameter:@ %s@]"
        (MBytes.to_string bytes))
    Data_encoding.(obj1 (req "contents" bytes))
    (function Failed_to_parse_parameter data -> Some data | _ -> None)
    (fun data -> Failed_to_parse_parameter data) ;
  register_error_kind
    `Temporary
    ~id:"context.failed_to_decode_parameter"
    ~title:"Failed to decode parameter"
    ~description:"Unexpected JSON object."
    ~pp:(fun ppf (json, msg) ->
      Format.fprintf
        ppf
        "@[<v 2>Cannot decode the protocol parameter:@ %s@ %a@]"
        msg
        Data_encoding.Json.pp
        json)
    Data_encoding.(obj2 (req "contents" json) (req "error" string))
    (function
      | Failed_to_decode_parameter (json, msg) -> Some (json, msg) | _ -> None)
    (fun (json, msg) -> Failed_to_decode_parameter (json, msg))

let get_proto_param ctxt =
  Context.get ctxt protocol_param_key
  >>= function
  | None ->
      failwith "Missing protocol parameters."
  | Some bytes -> (
    match Data_encoding.Binary.of_bytes Data_encoding.json bytes with
    | None ->
        fail (Failed_to_parse_parameter bytes)
    | Some json -> (
        Context.del ctxt protocol_param_key
        >>= fun ctxt ->
        match Data_encoding.Json.destruct Parameters_repr.encoding json with
        | exception (Data_encoding.Json.Cannot_destruct _ as exn) ->
            Format.kasprintf
              failwith
              "Invalid protocol_parameters: %a %a"
              (fun ppf -> Data_encoding.Json.print_error ppf)
              exn
              Data_encoding.Json.pp
              json
        | param ->
            return (param, ctxt) ) )

let set_constants ctxt constants =
  let bytes =
    Data_encoding.Binary.to_bytes_exn
      Constants_repr.parametric_encoding
      constants
  in
  Context.set ctxt constants_key bytes

let get_constants ctxt =
  Context.get ctxt constants_key
  >>= function
  | None ->
      failwith "Internal error: cannot read constants in context."
  | Some bytes -> (
    match
      Data_encoding.Binary.of_bytes Constants_repr.parametric_encoding bytes
    with
    | None ->
        failwith "Internal error: cannot parse constants in context."
    | Some constants ->
        return constants )

let patch_constants ctxt f =
  let constants = f ctxt.constants in
  set_constants ctxt.context constants
  >>= fun context -> Lwt.return {ctxt with context; constants}

let check_inited ctxt =
  Context.get ctxt version_key
  >>= function
  | None ->
      failwith "Internal error: un-initialized context."
  | Some bytes ->
      let s = MBytes.to_string bytes in
      if Compare.String.(s = version_value) then return_unit
      else storage_error (Incompatible_protocol_version s)

let prepare ~level ~predecessor_timestamp ~timestamp ~fitness ctxt =
  Lwt.return (Raw_level_repr.of_int32 level)
  >>=? fun level ->
  Lwt.return (Fitness_repr.to_int64 fitness)
  >>=? fun fitness ->
  check_inited ctxt
  >>=? fun () ->
  get_constants ctxt
  >>=? fun constants ->
  get_first_level ctxt
  >>=? fun first_level ->
  let level =
    Level_repr.from_raw
      ~first_level
      ~blocks_per_cycle:constants.Constants_repr.blocks_per_cycle
      ~blocks_per_voting_period:
        constants.Constants_repr.blocks_per_voting_period
      ~blocks_per_commitment:constants.Constants_repr.blocks_per_commitment
      level
  in
  return
    {
      context = ctxt;
      constants;
      level;
      predecessor_timestamp;
      timestamp;
      fitness;
      first_level;
      allowed_endorsements = Signature.Public_key_hash.Map.empty;
      included_endorsements = 0;
      fees = Tez_repr.zero;
      rewards = Tez_repr.zero;
      deposits = Signature.Public_key_hash.Map.empty;
      operation_gas = Unaccounted;
      internal_gas = Gas_limit_repr.internal_gas_zero;
      storage_space_to_pay = None;
      allocated_contracts = None;
      block_gas = constants.Constants_repr.hard_gas_limit_per_block;
      origination_nonce = None;
      temporary_big_map = Z.sub Z.zero Z.one;
      internal_nonce = 0;
      internal_nonces_used = Int_set.empty;
    }

type previous_protocol = Genesis of Parameters_repr.t | Alpha_previous

let check_and_update_protocol_version ctxt =
  Context.get ctxt version_key
  >>= (function
        | None ->
            failwith
              "Internal error: un-initialized context in check_first_block."
        | Some bytes ->
            let s = MBytes.to_string bytes in
            if Compare.String.(s = version_value) then
              failwith "Internal error: previously initialized context."
            else if Compare.String.(s = "genesis") then
              get_proto_param ctxt
              >>=? fun (param, ctxt) -> return (Genesis param, ctxt)
            else if Compare.String.(s = "alpha_previous") then
              return (Alpha_previous, ctxt)
            else storage_error (Incompatible_protocol_version s))
  >>=? fun (previous_proto, ctxt) ->
  Context.set ctxt version_key (MBytes.of_string version_value)
  >>= fun ctxt -> return (previous_proto, ctxt)

let prepare_first_block ~level ~timestamp ~fitness ctxt =
  check_and_update_protocol_version ctxt
  >>=? fun (previous_proto, ctxt) ->
  ( match previous_proto with
  | Genesis param ->
      Lwt.return (Raw_level_repr.of_int32 level)
      >>=? fun first_level ->
      set_first_level ctxt first_level
      >>=? fun ctxt ->
      set_constants ctxt param.constants >>= fun ctxt -> return ctxt
  | Alpha_previous ->
      return ctxt )
  >>=? fun ctxt ->
  prepare ctxt ~level ~predecessor_timestamp:timestamp ~timestamp ~fitness
  >>=? fun ctxt -> return (previous_proto, ctxt)

let activate ({context = c; _} as s) h =
  Updater.activate c h >>= fun c -> Lwt.return {s with context = c}

let fork_test_chain ({context = c; _} as s) protocol expiration =
  Updater.fork_test_chain c ~protocol ~expiration
  >>= fun c -> Lwt.return {s with context = c}

(* Generic context ********************************************************)

type key = string list

type value = MBytes.t

module type T = sig
  type t

  type context = t

  val mem : context -> key -> bool Lwt.t

  val dir_mem : context -> key -> bool Lwt.t

  val get : context -> key -> value tzresult Lwt.t

  val get_option : context -> key -> value option Lwt.t

  val init : context -> key -> value -> context tzresult Lwt.t

  val set : context -> key -> value -> context tzresult Lwt.t

  val init_set : context -> key -> value -> context Lwt.t

  val set_option : context -> key -> value option -> context Lwt.t

  val delete : context -> key -> context tzresult Lwt.t

  val remove : context -> key -> context Lwt.t

  val remove_rec : context -> key -> context Lwt.t

  val copy : context -> from:key -> to_:key -> context tzresult Lwt.t

  val fold :
    context ->
    key ->
    init:'a ->
    f:([`Key of key | `Dir of key] -> 'a -> 'a Lwt.t) ->
    'a Lwt.t

  val keys : context -> key -> key list Lwt.t

  val fold_keys :
    context -> key -> init:'a -> f:(key -> 'a -> 'a Lwt.t) -> 'a Lwt.t

  val project : context -> root_context

  val absolute_key : context -> key -> key

  val consume_gas : context -> Gas_limit_repr.cost -> context tzresult

  val check_enough_gas : context -> Gas_limit_repr.cost -> unit tzresult

  val description : context Storage_description.t
end

let mem ctxt k = Context.mem ctxt.context k

let dir_mem ctxt k = Context.dir_mem ctxt.context k

let get ctxt k =
  Context.get ctxt.context k
  >>= function
  | None -> storage_error (Missing_key (k, `Get)) | Some v -> return v

let get_option ctxt k = Context.get ctxt.context k

(* Verify that the k is present before modifying *)
let set ctxt k v =
  Context.mem ctxt.context k
  >>= function
  | false ->
      storage_error (Missing_key (k, `Set))
  | true ->
      Context.set ctxt.context k v
      >>= fun context -> return {ctxt with context}

(* Verify that the k is not present before inserting *)
let init ctxt k v =
  Context.mem ctxt.context k
  >>= function
  | true ->
      storage_error (Existing_key k)
  | false ->
      Context.set ctxt.context k v
      >>= fun context -> return {ctxt with context}

(* Does not verify that the key is present or not *)
let init_set ctxt k v =
  Context.set ctxt.context k v
  >>= fun context -> Lwt.return {ctxt with context}

(* Verify that the key is present before deleting *)
let delete ctxt k =
  Context.mem ctxt.context k
  >>= function
  | false ->
      storage_error (Missing_key (k, `Del))
  | true ->
      Context.del ctxt.context k >>= fun context -> return {ctxt with context}

(* Do not verify before deleting *)
let remove ctxt k =
  Context.del ctxt.context k >>= fun context -> Lwt.return {ctxt with context}

let set_option ctxt k = function
  | None ->
      remove ctxt k
  | Some v ->
      init_set ctxt k v

let remove_rec ctxt k =
  Context.remove_rec ctxt.context k
  >>= fun context -> Lwt.return {ctxt with context}

let copy ctxt ~from ~to_ =
  Context.copy ctxt.context ~from ~to_
  >>= function
  | None ->
      storage_error (Missing_key (from, `Copy))
  | Some context ->
      return {ctxt with context}

let fold ctxt k ~init ~f = Context.fold ctxt.context k ~init ~f

let keys ctxt k = Context.keys ctxt.context k

let fold_keys ctxt k ~init ~f = Context.fold_keys ctxt.context k ~init ~f

let project x = x

let absolute_key _ k = k

let description = Storage_description.create ()

let fresh_temporary_big_map ctxt =
  ( {ctxt with temporary_big_map = Z.sub ctxt.temporary_big_map Z.one},
    ctxt.temporary_big_map )

let reset_temporary_big_map ctxt =
  {ctxt with temporary_big_map = Z.sub Z.zero Z.one}

let temporary_big_maps ctxt f acc =
  let rec iter acc id =
    if Z.equal id ctxt.temporary_big_map then Lwt.return acc
    else f acc id >>= fun acc -> iter acc (Z.sub id Z.one)
  in
  iter acc (Z.sub Z.zero Z.one)

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

(* ❌ Applications of functors are not handled. *)
functor_application

Module t.
  Record record := {
    context : Tezos_protocol_environment_alpha__Environment.Context.t;
    constants : Tezos_raw_protocol_alpha.Constants_repr.parametric;
    first_level : Tezos_raw_protocol_alpha.Raw_level_repr.t;
    level : Tezos_raw_protocol_alpha.Level_repr.t;
    predecessor_timestamp : Tezos_protocol_environment_alpha__Environment.Time.t;
    timestamp : Tezos_protocol_environment_alpha__Environment.Time.t;
    fitness : Tezos_protocol_environment_alpha__Environment.Int64.t;
    deposits :
      Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.Map.t
        Tezos_raw_protocol_alpha.Tez_repr.t;
    included_endorsements : Z;
    allowed_endorsements :
      Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.Map.t
        (Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t *
          list Z * bool);
    fees : Tezos_raw_protocol_alpha.Tez_repr.t;
    rewards : Tezos_raw_protocol_alpha.Tez_repr.t;
    block_gas : Tezos_protocol_environment_alpha__Environment.Z.t;
    operation_gas : Tezos_raw_protocol_alpha.Gas_limit_repr.t;
    internal_gas : Tezos_raw_protocol_alpha.Gas_limit_repr.internal_gas;
    storage_space_to_pay :
      option Tezos_protocol_environment_alpha__Environment.Z.t;
    allocated_contracts : option Z;
    origination_nonce :
      option Tezos_raw_protocol_alpha.Contract_repr.origination_nonce;
    temporary_big_map : Tezos_protocol_environment_alpha__Environment.Z.t;
    internal_nonce : Z;
    internal_nonces_used : Int_set.t }.
End t.
Definition t := t.record.

Definition context := t.

Definition root_context := t.

Definition current_level (ctxt : t) : Tezos_raw_protocol_alpha.Level_repr.t :=
  t.level ctxt.

Definition predecessor_timestamp (ctxt : t)
  : Tezos_protocol_environment_alpha__Environment.Time.t :=
  t.predecessor_timestamp ctxt.

Definition current_timestamp (ctxt : t)
  : Tezos_protocol_environment_alpha__Environment.Time.t := t.timestamp ctxt.

Definition current_fitness (ctxt : t)
  : Tezos_protocol_environment_alpha__Environment.Int64.t := t.fitness ctxt.

Definition first_level (ctxt : t) : Tezos_raw_protocol_alpha.Raw_level_repr.t :=
  t.first_level ctxt.

Definition constants (ctxt : t)
  : Tezos_raw_protocol_alpha.Constants_repr.parametric := t.constants ctxt.

Definition recover (ctxt : t)
  : Tezos_protocol_environment_alpha__Environment.Context.t := t.context ctxt.

Definition record_endorsement
  (ctxt : t)
  (k :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.Map.key)
  : t :=
  match Signature.Public_key_hash.Map.find_opt k (t.allowed_endorsements ctxt)
    with
  | None =>
    (* ❌ Assert instruction is not handled. *)
    assert false
  | Some (_, _, true) =>
    (* ❌ Assert instruction is not handled. *)
    assert false
  | Some (d, s, false) =>
    (* ❌ Record substitution not handled *)
    record_substitution
  end.

Definition init_endorsements
  (ctxt : t)
  (allowed_endorsements :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.Map.t
      (Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t *
        list Z * bool)) : t :=
  if Signature.Public_key_hash.Map.is_empty allowed_endorsements then
    (* ❌ Assert instruction is not handled. *)
    assert false
  else
    if Signature.Public_key_hash.Map.is_empty (t.allowed_endorsements ctxt) then
      (* ❌ Record substitution not handled *)
      record_substitution
    else
      (* ❌ Assert instruction is not handled. *)
      assert false.

Definition allowed_endorsements (ctxt : t)
  : Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.Map.t
    (Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t *
      list Z * bool) := t.allowed_endorsements ctxt.

Definition included_endorsements (ctxt : t) : Z := t.included_endorsements ctxt.

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Top-level evaluations are considered as an error as sources of side-effects *)
Compute
  register_error_kind
    (* ❌ Variants not supported *)
    variant "too_many_internal_operations" % string
    "Too many internal operations" % string
    "A transaction exceeded the hard limit of internal operations it can emit" %
      string None empty
    (fun function_parameter =>
      match function_parameter with
      |
        Tezos_protocol_environment_alpha__Environment.Error_monad.Too_many_internal_operations
        => Some tt
      | _ => None
      end)
    (fun function_parameter =>
      let 'tt := function_parameter in
      Tezos_protocol_environment_alpha__Environment.Error_monad.Too_many_internal_operations).

Definition fresh_internal_nonce (ctxt : t)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult (t * Z) :=
  if op_gteq (t.internal_nonce ctxt) 65535 then
    __error_value
      Tezos_protocol_environment_alpha__Environment.Error_monad.Too_many_internal_operations
  else
    ok
      ((* ❌ Record substitution not handled *)
      record_substitution, (t.internal_nonce ctxt)).

Definition reset_internal_nonce (ctxt : t) : t :=
  (* ❌ Record substitution not handled *)
  record_substitution.

Definition record_internal_nonce (ctxt : t) (k : Int_set.elt) : t :=
  (* ❌ Record substitution not handled *)
  record_substitution.

Definition internal_nonce_already_recorded (ctxt : t) (k : Int_set.elt)
  : bool := Int_set.mem k (t.internal_nonces_used ctxt).

Definition set_current_fitness
  (ctxt : t) (fitness : Tezos_protocol_environment_alpha__Environment.Int64.t)
  : t :=
  (* ❌ Record substitution not handled *)
  record_substitution.

Definition add_fees (ctxt : t) (fees : Tezos_raw_protocol_alpha.Tez_repr.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult t) :=
  op_gtgteqquestion (Lwt.__return (op_plusquestion (t.fees ctxt) fees))
    (fun fees =>
      __return
        (* ❌ Record substitution not handled *)
        record_substitution).

Definition add_rewards
  (ctxt : t) (rewards : Tezos_raw_protocol_alpha.Tez_repr.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult t) :=
  op_gtgteqquestion (Lwt.__return (op_plusquestion (t.rewards ctxt) rewards))
    (fun rewards =>
      __return
        (* ❌ Record substitution not handled *)
        record_substitution).

Definition add_deposit
  (ctxt : t)
  (delegate :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.Map.key)
  (deposit : Tezos_raw_protocol_alpha.Tez_repr.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult t) :=
  let previous :=
    match Signature.Public_key_hash.Map.find_opt delegate (t.deposits ctxt) with
    | Some tz => tz
    | None => Tez_repr.zero
    end in
  op_gtgteqquestion (Lwt.__return (op_plusquestion previous deposit))
    (fun deposit =>
      let deposits :=
        Signature.Public_key_hash.Map.add delegate deposit (t.deposits ctxt) in
      __return
        (* ❌ Record substitution not handled *)
        record_substitution).

Definition get_deposits (ctxt : t)
  : Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.Map.t
    Tezos_raw_protocol_alpha.Tez_repr.t := t.deposits ctxt.

Definition get_rewards (ctxt : t) : Tezos_raw_protocol_alpha.Tez_repr.t :=
  t.rewards ctxt.

Definition get_fees (ctxt : t) : Tezos_raw_protocol_alpha.Tez_repr.t :=
  t.fees ctxt.

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Top-level evaluations are considered as an error as sources of side-effects *)
Compute
  register_error_kind
    (* ❌ Variants not supported *)
    variant "undefined_operation_nonce" % string
    "Ill timed access to the origination nonce" % string
    "An origination was attemped out of the scope of a manager operation" %
      string None empty
    (fun function_parameter =>
      match function_parameter with
      |
        Tezos_protocol_environment_alpha__Environment.Error_monad.Undefined_operation_nonce
        => Some tt
      | _ => None
      end)
    (fun function_parameter =>
      let 'tt := function_parameter in
      Tezos_protocol_environment_alpha__Environment.Error_monad.Undefined_operation_nonce).

Definition init_origination_nonce
  (ctxt : t)
  (operation_hash :
    Tezos_protocol_environment_alpha__Environment.Operation_hash.t) : t :=
  let origination_nonce :=
    Some (Contract_repr.initial_origination_nonce operation_hash) in
  (* ❌ Record substitution not handled *)
  record_substitution.

Definition origination_nonce (ctxt : t)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    Tezos_raw_protocol_alpha.Contract_repr.origination_nonce :=
  match t.origination_nonce ctxt with
  | None =>
    __error_value
      Tezos_protocol_environment_alpha__Environment.Error_monad.Undefined_operation_nonce
  | Some origination_nonce => ok origination_nonce
  end.

Definition increment_origination_nonce (ctxt : t)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (t * Tezos_raw_protocol_alpha.Contract_repr.origination_nonce) :=
  match t.origination_nonce ctxt with
  | None =>
    __error_value
      Tezos_protocol_environment_alpha__Environment.Error_monad.Undefined_operation_nonce
  | Some cur_origination_nonce =>
    let origination_nonce :=
      Some (Contract_repr.incr_origination_nonce cur_origination_nonce) in
    ok
      ((* ❌ Record substitution not handled *)
      record_substitution, cur_origination_nonce)
  end.

Definition unset_origination_nonce (ctxt : t) : t :=
  (* ❌ Record substitution not handled *)
  record_substitution.

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Top-level evaluations are considered as an error as sources of side-effects *)
Compute
  register_error_kind
    (* ❌ Variants not supported *)
    variant "gas_limit_too_high" % string
    "Gas limit out of protocol hard bounds" % string
    "A transaction tried to exceed the hard limit on gas" % string None empty
    (fun function_parameter =>
      match function_parameter with
      |
        Tezos_protocol_environment_alpha__Environment.Error_monad.Gas_limit_too_high
        => Some tt
      | _ => None
      end)
    (fun function_parameter =>
      let 'tt := function_parameter in
      Tezos_protocol_environment_alpha__Environment.Error_monad.Gas_limit_too_high).

Definition check_gas_limit
  (ctxt : t)
  (remaining : Tezos_protocol_environment_alpha__Environment.Compare.Z.t)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit :=
  if
    op_pipepipe
      (op_gt remaining
        (Tezos_raw_protocol_alpha.Constants_repr.parametric.hard_gas_limit_per_operation
          (t.constants ctxt))) (op_lt remaining Z.zero) then
    __error_value
      Tezos_protocol_environment_alpha__Environment.Error_monad.Gas_limit_too_high
  else
    ok tt.

Definition set_gas_limit
  (ctxt : t) (remaining : Tezos_protocol_environment_alpha__Environment.Z.t)
  : t :=
  (* ❌ Record substitution not handled *)
  record_substitution.

Definition set_gas_unlimited (ctxt : t) : t :=
  (* ❌ Record substitution not handled *)
  record_substitution.

Definition consume_gas
  (ctxt : t) (cost : Tezos_raw_protocol_alpha.Gas_limit_repr.cost)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult t :=
  op_gtgtquestion
    (Gas_limit_repr.consume (t.block_gas ctxt) (t.operation_gas ctxt)
      (t.internal_gas ctxt) cost)
    (fun function_parameter =>
      let '(block_gas, operation_gas, internal_gas) := function_parameter in
      ok
        (* ❌ Record substitution not handled *)
        record_substitution).

Definition check_enough_gas
  (ctxt : t) (cost : Tezos_raw_protocol_alpha.Gas_limit_repr.cost)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit :=
  Gas_limit_repr.check_enough (t.block_gas ctxt) (t.operation_gas ctxt)
    (t.internal_gas ctxt) cost.

Definition gas_level (ctxt : t) : Tezos_raw_protocol_alpha.Gas_limit_repr.t :=
  t.operation_gas ctxt.

Definition block_gas_level (ctxt : t)
  : Tezos_protocol_environment_alpha__Environment.Z.t := t.block_gas ctxt.

Definition gas_consumed (since : t) (until : t)
  : Tezos_protocol_environment_alpha__Environment.Z.t :=
  match ((gas_level since), (gas_level until)) with
  |
    (Tezos_raw_protocol_alpha.Gas_limit_repr.Limited {|
      Tezos_raw_protocol_alpha.Gas_limit_repr.t.Limited.remaining := before
        |},
      Tezos_raw_protocol_alpha.Gas_limit_repr.Limited {|
        Tezos_raw_protocol_alpha.Gas_limit_repr.t.Limited.remaining := after
          |}) => Z.sub before after
  | (_, _) => Z.zero
  end.

Definition init_storage_space_to_pay (ctxt : t) : t :=
  match t.storage_space_to_pay ctxt with
  | Some _ =>
    (* ❌ Assert instruction is not handled. *)
    assert false
  | None =>
    (* ❌ Record substitution not handled *)
    record_substitution
  end.

Definition update_storage_space_to_pay
  (ctxt : t) (n : Tezos_protocol_environment_alpha__Environment.Z.t) : t :=
  match t.storage_space_to_pay ctxt with
  | None =>
    (* ❌ Assert instruction is not handled. *)
    assert false
  | Some storage_space_to_pay =>
    (* ❌ Record substitution not handled *)
    record_substitution
  end.

Definition update_allocated_contracts_count (ctxt : t) : t :=
  match t.allocated_contracts ctxt with
  | None =>
    (* ❌ Assert instruction is not handled. *)
    assert false
  | Some allocated_contracts =>
    (* ❌ Record substitution not handled *)
    record_substitution
  end.

Definition clear_storage_space_to_pay (ctxt : t)
  : t * Tezos_protocol_environment_alpha__Environment.Z.t * Z :=
  match ((t.storage_space_to_pay ctxt), (t.allocated_contracts ctxt)) with
  | (None, _) | (_, None) =>
    (* ❌ Assert instruction is not handled. *)
    assert false
  | (Some storage_space_to_pay, Some allocated_contracts) =>
    ((* ❌ Record substitution not handled *)
    record_substitution, storage_space_to_pay, allocated_contracts)
  end.

Inductive storage_error : Set :=
| Incompatible_protocol_version : string -> storage_error
| Missing_key :
  list string ->
  (* `Del *) unit + (* `Copy *) unit + (* `Get *) unit + (* `Set *) unit ->
  storage_error
| Existing_key : list string -> storage_error
| Corrupted_data : list string -> storage_error.

Definition storage_error_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    storage_error :=
  union None
    (cons
      (__case_value "Incompatible_protocol_version" % string None
        (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag 0)
        (obj1
          (req None None "incompatible_protocol_version" % string __string_value))
        (fun function_parameter =>
          match function_parameter with
          | Incompatible_protocol_version arg => Some arg
          | _ => None
          end) (fun arg => Incompatible_protocol_version arg))
      (cons
        (__case_value "Missing_key" % string None
          (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag 1)
          (obj2
            (req None None "missing_key" % string
              (__list_value None __string_value))
            (req None None "function" % string
              (string_enum
                (cons
                  ("get" % string,
                    (* ❌ Variants not supported *)
                    variant)
                  (cons
                    ("set" % string,
                      (* ❌ Variants not supported *)
                      variant)
                    (cons
                      ("del" % string,
                        (* ❌ Variants not supported *)
                        variant)
                      (cons
                        ("copy" % string,
                          (* ❌ Variants not supported *)
                          variant) [])))))))
          (fun function_parameter =>
            match function_parameter with
            | Missing_key key f => Some (key, f)
            | _ => None
            end)
          (fun function_parameter =>
            let '(key, f) := function_parameter in
            Missing_key key f))
        (cons
          (__case_value "Existing_key" % string None
            (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag 2)
            (obj1
              (req None None "existing_key" % string
                (__list_value None __string_value)))
            (fun function_parameter =>
              match function_parameter with
              | Existing_key key => Some key
              | _ => None
              end) (fun key => Existing_key key))
          (cons
            (__case_value "Corrupted_data" % string None
              (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag 3)
              (obj1
                (req None None "corrupted_data" % string
                  (__list_value None __string_value)))
              (fun function_parameter =>
                match function_parameter with
                | Corrupted_data key => Some key
                | _ => None
                end) (fun key => Corrupted_data key)) [])))).

Definition pp_storage_error
  (ppf : Tezos_protocol_environment_alpha__Environment.Format.formatter)
  (function_parameter : storage_error) : unit :=
  match function_parameter with
  | Incompatible_protocol_version version =>
    Format.fprintf ppf
      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
          "Found a context with an unexpected version '" % string
          (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String
            Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
              "'." % string
              Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))
        "Found a context with an unexpected version '%s'." % string) version
  | Missing_key key Get =>
    Format.fprintf ppf
      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
          "Missing key '" % string
          (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String
            Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
              "'." % string
              Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))
        "Missing key '%s'." % string) (String.concat "/" % string key)
  | Missing_key key __Set =>
    Format.fprintf ppf
      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
          "Cannot set undefined key '" % string
          (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String
            Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
              "'." % string
              Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))
        "Cannot set undefined key '%s'." % string)
      (String.concat "/" % string key)
  | Missing_key key Del =>
    Format.fprintf ppf
      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
          "Cannot delete undefined key '" % string
          (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String
            Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
              "'." % string
              Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))
        "Cannot delete undefined key '%s'." % string)
      (String.concat "/" % string key)
  | Missing_key key Copy =>
    Format.fprintf ppf
      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
          "Cannot copy undefined key '" % string
          (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String
            Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
              "'." % string
              Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))
        "Cannot copy undefined key '%s'." % string)
      (String.concat "/" % string key)
  | Existing_key key =>
    Format.fprintf ppf
      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
          "Cannot initialize defined key '" % string
          (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String
            Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
              "'." % string
              Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))
        "Cannot initialize defined key '%s'." % string)
      (String.concat "/" % string key)
  | Corrupted_data key =>
    Format.fprintf ppf
      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
          "Failed to parse the data at '" % string
          (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String
            Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
              "'." % string
              Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))
        "Failed to parse the data at '%s'." % string)
      (String.concat "/" % string key)
  end.

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Top-level evaluations are considered as an error as sources of side-effects *)
Compute
  register_error_kind
    (* ❌ Variants not supported *)
    variant "context.storage_error" % string
    "Storage error (fatal internal error)" % string
    "An error that should never happen unless something has been deleted or corrupted in the database."
      % string
    (Some
      (fun ppf =>
        fun err =>
          Format.fprintf ppf
            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Formatting_gen
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Open_box
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                      "<v 2>" % string
                      Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
                    "<v 2>" % string))
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Storage error:" % string
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Formatting_lit
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Break
                      "@ " % string 1 0)
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Formatting_lit
                        Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Close_box
                        Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))))
              "@[<v 2>Storage error:@ %a@]" % string) pp_storage_error err))
    storage_error_encoding
    (fun function_parameter =>
      match function_parameter with
      |
        Tezos_protocol_environment_alpha__Environment.Error_monad.Storage_error
          err => Some err
      | _ => None
      end)
    (fun err =>
      Tezos_protocol_environment_alpha__Environment.Error_monad.Storage_error
        err).

Definition storage_error {A : Set} (err : storage_error)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult A) :=
  fail
    (Tezos_protocol_environment_alpha__Environment.Error_monad.Storage_error err).

Definition version_key : list string := cons "version" % string [].

Definition version_value : string := "alpha_current" % string.

Definition version : string := "v1" % string.

Definition first_level_key : list string :=
  cons version (cons "first_level" % string []).

Definition constants_key : list string :=
  cons version (cons "constants" % string []).

Definition protocol_param_key : list string :=
  cons "protocol_parameters" % string [].

Definition get_first_level
  (ctxt : Tezos_protocol_environment_alpha__Environment.Context.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_level_repr.raw_level) :=
  op_gtgteq (Context.get ctxt first_level_key)
    (fun function_parameter =>
      match function_parameter with
      | None =>
        storage_error
          (Missing_key first_level_key
            (* ❌ Variants not supported *)
            variant)
      | Some __bytes_value =>
        match
          Data_encoding.Binary.of_bytes Raw_level_repr.encoding __bytes_value
          with
        | None => storage_error (Corrupted_data first_level_key)
        | Some level => __return level
        end
      end).

Definition set_first_level
  (ctxt : Tezos_protocol_environment_alpha__Environment.Context.t)
  (level : Tezos_raw_protocol_alpha.Raw_level_repr.raw_level)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_protocol_environment_alpha__Environment.Context.t) :=
  let __bytes_value :=
    Data_encoding.Binary.to_bytes_exn Raw_level_repr.encoding level in
  op_gtgteq (Context.set ctxt first_level_key __bytes_value)
    (fun ctxt => __return ctxt).

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Top-level evaluations are considered as an error as sources of side-effects *)
Compute
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "context.failed_to_parse_parameter" % string
      "Failed to parse parameter" % string
      "The protocol parameters are not valid JSON." % string
      (Some
        (fun ppf =>
          fun __bytes_value =>
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Formatting_gen
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Open_box
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                        "<v 2>" % string
                        Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
                      "<v 2>" % string))
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                    "Cannot parse the protocol parameter:" % string
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Formatting_lit
                      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Break
                        "@ " % string 1 0)
                      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String
                        Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
                        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Formatting_lit
                          Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Close_box
                          Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))))
                "@[<v 2>Cannot parse the protocol parameter:@ %s@]" % string)
              (MBytes.to_string __bytes_value)))
      (obj1 (req None None "contents" % string __bytes_value))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Failed_to_parse_parameter
            data => Some data
        | _ => None
        end)
      (fun data =>
        Tezos_protocol_environment_alpha__Environment.Error_monad.Failed_to_parse_parameter
          data) in
  register_error_kind
    (* ❌ Variants not supported *)
    variant "context.failed_to_decode_parameter" % string
    "Failed to decode parameter" % string "Unexpected JSON object." % string
    (Some
      (fun ppf =>
        fun function_parameter =>
          let '(__json_value, msg) := function_parameter in
          Format.fprintf ppf
            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Formatting_gen
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Open_box
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                      "<v 2>" % string
                      Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
                    "<v 2>" % string))
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Cannot decode the protocol parameter:" % string
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Formatting_lit
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Break
                      "@ " % string 1 0)
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String
                      Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
                      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Formatting_lit
                        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Break
                          "@ " % string 1 0)
                        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                          (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Formatting_lit
                            Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Close_box
                            Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))))))
              "@[<v 2>Cannot decode the protocol parameter:@ %s@ %a@]" % string)
            msg Data_encoding.Json.pp __json_value))
    (obj2 (req None None "contents" % string __json_value)
      (req None None "error" % string __string_value))
    (fun function_parameter =>
      match function_parameter with
      |
        Tezos_protocol_environment_alpha__Environment.Error_monad.Failed_to_decode_parameter
          __json_value msg => Some (__json_value, msg)
      | _ => None
      end)
    (fun function_parameter =>
      let '(__json_value, msg) := function_parameter in
      Tezos_protocol_environment_alpha__Environment.Error_monad.Failed_to_decode_parameter
        __json_value msg).

Definition get_proto_param
  (ctxt : Tezos_protocol_environment_alpha__Environment.Context.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Parameters_repr.t *
        Tezos_protocol_environment_alpha__Environment.Context.t)) :=
  op_gtgteq (Context.get ctxt protocol_param_key)
    (fun function_parameter =>
      match function_parameter with
      | None => failwith "Missing protocol parameters." % string
      | Some __bytes_value =>
        match
          Data_encoding.Binary.of_bytes Data_encoding.__json_value __bytes_value
          with
        | None =>
          fail
            (Tezos_protocol_environment_alpha__Environment.Error_monad.Failed_to_parse_parameter
              __bytes_value)
        | Some __json_value =>
          op_gtgteq (Context.del ctxt protocol_param_key)
            (fun ctxt =>
              let 'param :=
                Data_encoding.Json.destruct Parameters_repr.encoding
                  __json_value in
              __return (param, ctxt))
        end
      end).

Definition set_constants
  (ctxt : Tezos_protocol_environment_alpha__Environment.Context.t)
  (constants : Tezos_raw_protocol_alpha.Constants_repr.parametric)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    Tezos_protocol_environment_alpha__Environment.Context.t :=
  let __bytes_value :=
    Data_encoding.Binary.to_bytes_exn Constants_repr.parametric_encoding
      constants in
  Context.set ctxt constants_key __bytes_value.

Definition get_constants
  (ctxt : Tezos_protocol_environment_alpha__Environment.Context.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Constants_repr.parametric) :=
  op_gtgteq (Context.get ctxt constants_key)
    (fun function_parameter =>
      match function_parameter with
      | None =>
        failwith "Internal error: cannot read constants in context." % string
      | Some __bytes_value =>
        match
          Data_encoding.Binary.of_bytes Constants_repr.parametric_encoding
            __bytes_value with
        | None =>
          failwith "Internal error: cannot parse constants in context." % string
        | Some constants => __return constants
        end
      end).

Definition patch_constants
  (ctxt : t)
  (f :
    Tezos_raw_protocol_alpha.Constants_repr.parametric ->
    Tezos_raw_protocol_alpha.Constants_repr.parametric)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t t :=
  let constants := f (t.constants ctxt) in
  op_gtgteq (set_constants (t.context ctxt) constants)
    (fun context =>
      Lwt.__return
        (* ❌ Record substitution not handled *)
        record_substitution).

Definition check_inited
  (ctxt : Tezos_protocol_environment_alpha__Environment.Context.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
  op_gtgteq (Context.get ctxt version_key)
    (fun function_parameter =>
      match function_parameter with
      | None => failwith "Internal error: un-initialized context." % string
      | Some __bytes_value =>
        let s := MBytes.to_string __bytes_value in
        if op_eq s version_value then
          return_unit
        else
          storage_error (Incompatible_protocol_version s)
      end).

Definition prepare
  (level : int32)
  (predecessor_timestamp : Tezos_protocol_environment_alpha__Environment.Time.t)
  (timestamp : Tezos_protocol_environment_alpha__Environment.Time.t)
  (fitness : list Tezos_protocol_environment_alpha__Environment.MBytes.t)
  (ctxt : Tezos_protocol_environment_alpha__Environment.Context.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult t) :=
  op_gtgteqquestion (Lwt.__return (Raw_level_repr.of_int32 level))
    (fun level =>
      op_gtgteqquestion (Lwt.__return (Fitness_repr.to_int64 fitness))
        (fun fitness =>
          op_gtgteqquestion (check_inited ctxt)
            (fun function_parameter =>
              let 'tt := function_parameter in
              op_gtgteqquestion (get_constants ctxt)
                (fun constants =>
                  op_gtgteqquestion (get_first_level ctxt)
                    (fun first_level =>
                      let level :=
                        Level_repr.from_raw first_level
                          (Tezos_raw_protocol_alpha.Constants_repr.parametric.blocks_per_cycle
                            constants)
                          (Tezos_raw_protocol_alpha.Constants_repr.parametric.blocks_per_voting_period
                            constants)
                          (Tezos_raw_protocol_alpha.Constants_repr.parametric.blocks_per_commitment
                            constants) level in
                      __return
                        {| t.context := ctxt; t.constants := constants;
                          t.first_level := first_level; t.level := level;
                          t.predecessor_timestamp := predecessor_timestamp;
                          t.timestamp := timestamp; t.fitness := fitness;
                          t.deposits := Signature.Public_key_hash.Map.empty;
                          t.included_endorsements := 0;
                          t.allowed_endorsements :=
                            Signature.Public_key_hash.Map.empty;
                          t.fees := Tez_repr.zero; t.rewards := Tez_repr.zero;
                          t.block_gas :=
                            Tezos_raw_protocol_alpha.Constants_repr.parametric.hard_gas_limit_per_block
                              constants;
                          t.operation_gas :=
                            Tezos_raw_protocol_alpha.Gas_limit_repr.Unaccounted;
                          t.internal_gas := Gas_limit_repr.internal_gas_zero;
                          t.storage_space_to_pay := None;
                          t.allocated_contracts := None;
                          t.origination_nonce := None;
                          t.temporary_big_map := Z.sub Z.zero Z.one;
                          t.internal_nonce := 0;
                          t.internal_nonces_used := Int_set.empty |}))))).

Inductive previous_protocol : Set :=
| Genesis : Tezos_raw_protocol_alpha.Parameters_repr.t -> previous_protocol
| Alpha_previous : previous_protocol.

Definition check_and_update_protocol_version
  (ctxt : Tezos_protocol_environment_alpha__Environment.Context.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (previous_protocol *
        Tezos_protocol_environment_alpha__Environment.Context.t)) :=
  op_gtgteqquestion
    (op_gtgteq (Context.get ctxt version_key)
      (fun function_parameter =>
        match function_parameter with
        | None =>
          failwith
            "Internal error: un-initialized context in check_first_block." %
              string
        | Some __bytes_value =>
          let s := MBytes.to_string __bytes_value in
          if op_eq s version_value then
            failwith "Internal error: previously initialized context." % string
          else
            if op_eq s "genesis" % string then
              op_gtgteqquestion (get_proto_param ctxt)
                (fun function_parameter =>
                  let '(param, ctxt) := function_parameter in
                  __return ((Genesis param), ctxt))
            else
              if op_eq s "alpha_previous" % string then
                __return (Alpha_previous, ctxt)
              else
                storage_error (Incompatible_protocol_version s)
        end))
    (fun function_parameter =>
      let '(previous_proto, ctxt) := function_parameter in
      op_gtgteq (Context.set ctxt version_key (MBytes.of_string version_value))
        (fun ctxt => __return (previous_proto, ctxt))).

Definition prepare_first_block
  (level : int32)
  (timestamp : Tezos_protocol_environment_alpha__Environment.Time.t)
  (fitness : list Tezos_protocol_environment_alpha__Environment.MBytes.t)
  (ctxt : Tezos_protocol_environment_alpha__Environment.Context.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (previous_protocol * t)) :=
  op_gtgteqquestion (check_and_update_protocol_version ctxt)
    (fun function_parameter =>
      let '(previous_proto, ctxt) := function_parameter in
      op_gtgteqquestion
        match previous_proto with
        | Genesis param =>
          op_gtgteqquestion (Lwt.__return (Raw_level_repr.of_int32 level))
            (fun first_level =>
              op_gtgteqquestion (set_first_level ctxt first_level)
                (fun ctxt =>
                  op_gtgteq
                    (set_constants ctxt
                      (Tezos_raw_protocol_alpha.Parameters_repr.t.constants
                        param)) (fun ctxt => __return ctxt)))
        | Alpha_previous => __return ctxt
        end
        (fun ctxt =>
          op_gtgteqquestion (prepare level timestamp timestamp fitness ctxt)
            (fun ctxt => __return (previous_proto, ctxt)))).

Definition activate (function_parameter : t)
  : Tezos_protocol_environment_alpha__Environment.Protocol_hash.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t t :=
  let '{| t.context := c |} as s := function_parameter in
  fun h =>
    op_gtgteq (Updater.activate c h)
      (fun c =>
        Lwt.__return
          (* ❌ Record substitution not handled *)
          record_substitution).

Definition fork_test_chain (function_parameter : t)
  : Tezos_protocol_environment_alpha__Environment.Protocol_hash.t ->
  Tezos_protocol_environment_alpha__Environment.Time.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t t :=
  let '{| t.context := c |} as s := function_parameter in
  fun protocol =>
    fun expiration =>
      op_gtgteq (Updater.fork_test_chain c protocol expiration)
        (fun c =>
          Lwt.__return
            (* ❌ Record substitution not handled *)
            record_substitution).

Definition key := list string.

Definition value := Tezos_protocol_environment_alpha__Environment.MBytes.t.

Module T.
  Record signature {t : Set} := {
    t := t;
    context := t;
    mem :
      context -> key -> Tezos_protocol_environment_alpha__Environment.Lwt.t bool;
    dir_mem :
      context -> key -> Tezos_protocol_environment_alpha__Environment.Lwt.t bool;
    get :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          value);
    get_option :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t (option value);
    init :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          context);
    set :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          context);
    init_set :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t context;
    set_option :
      context -> key -> option value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t context;
    delete :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          context);
    remove :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t context;
    remove_rec :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t context;
    copy :
      context -> key -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          context);
    fold : forall {a : Set},
      context -> key -> a ->
      ((* `Dir *) key + (* `Key *) key -> a ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a;
    keys :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t (list key);
    fold_keys : forall {a : Set},
      context -> key -> a ->
      (key -> a -> Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a;
    project : context -> root_context;
    absolute_key : context -> key -> key;
    consume_gas :
      context -> Tezos_raw_protocol_alpha.Gas_limit_repr.cost ->
      Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult context;
    check_enough_gas :
      context -> Tezos_raw_protocol_alpha.Gas_limit_repr.cost ->
      Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit;
    description : Tezos_raw_protocol_alpha.Storage_description.t context;
  }.
  Arguments signature : clear implicits.
End T.

Definition mem
  (ctxt : t) (k : Tezos_protocol_environment_alpha__Environment.Context.key)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t bool :=
  Context.mem (t.context ctxt) k.

Definition dir_mem
  (ctxt : t) (k : Tezos_protocol_environment_alpha__Environment.Context.key)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t bool :=
  Context.dir_mem (t.context ctxt) k.

Definition get
  (ctxt : t) (k : Tezos_protocol_environment_alpha__Environment.Context.key)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_protocol_environment_alpha__Environment.Context.value) :=
  op_gtgteq (Context.get (t.context ctxt) k)
    (fun function_parameter =>
      match function_parameter with
      | None =>
        storage_error
          (Missing_key k
            (* ❌ Variants not supported *)
            variant)
      | Some v => __return v
      end).

Definition get_option
  (ctxt : t) (k : Tezos_protocol_environment_alpha__Environment.Context.key)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (option Tezos_protocol_environment_alpha__Environment.Context.value) :=
  Context.get (t.context ctxt) k.

Definition set
  (ctxt : t) (k : Tezos_protocol_environment_alpha__Environment.Context.key)
  (v : Tezos_protocol_environment_alpha__Environment.Context.value)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult t) :=
  op_gtgteq (Context.mem (t.context ctxt) k)
    (fun function_parameter =>
      match function_parameter with
      | false =>
        storage_error
          (Missing_key k
            (* ❌ Variants not supported *)
            variant)
      | true =>
        op_gtgteq (Context.set (t.context ctxt) k v)
          (fun context =>
            __return
              (* ❌ Record substitution not handled *)
              record_substitution)
      end).

Definition init
  (ctxt : t) (k : Tezos_protocol_environment_alpha__Environment.Context.key)
  (v : Tezos_protocol_environment_alpha__Environment.Context.value)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult t) :=
  op_gtgteq (Context.mem (t.context ctxt) k)
    (fun function_parameter =>
      match function_parameter with
      | true => storage_error (Existing_key k)
      | false =>
        op_gtgteq (Context.set (t.context ctxt) k v)
          (fun context =>
            __return
              (* ❌ Record substitution not handled *)
              record_substitution)
      end).

Definition init_set
  (ctxt : t) (k : Tezos_protocol_environment_alpha__Environment.Context.key)
  (v : Tezos_protocol_environment_alpha__Environment.Context.value)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t t :=
  op_gtgteq (Context.set (t.context ctxt) k v)
    (fun context =>
      Lwt.__return
        (* ❌ Record substitution not handled *)
        record_substitution).

Definition delete
  (ctxt : t) (k : Tezos_protocol_environment_alpha__Environment.Context.key)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult t) :=
  op_gtgteq (Context.mem (t.context ctxt) k)
    (fun function_parameter =>
      match function_parameter with
      | false =>
        storage_error
          (Missing_key k
            (* ❌ Variants not supported *)
            variant)
      | true =>
        op_gtgteq (Context.del (t.context ctxt) k)
          (fun context =>
            __return
              (* ❌ Record substitution not handled *)
              record_substitution)
      end).

Definition remove
  (ctxt : t) (k : Tezos_protocol_environment_alpha__Environment.Context.key)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t t :=
  op_gtgteq (Context.del (t.context ctxt) k)
    (fun context =>
      Lwt.__return
        (* ❌ Record substitution not handled *)
        record_substitution).

Definition set_option
  (ctxt : t) (k : Tezos_protocol_environment_alpha__Environment.Context.key)
  (function_parameter :
    option Tezos_protocol_environment_alpha__Environment.Context.value)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t t :=
  match function_parameter with
  | None => remove ctxt k
  | Some v => init_set ctxt k v
  end.

Definition remove_rec
  (ctxt : t) (k : Tezos_protocol_environment_alpha__Environment.Context.key)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t t :=
  op_gtgteq (Context.remove_rec (t.context ctxt) k)
    (fun context =>
      Lwt.__return
        (* ❌ Record substitution not handled *)
        record_substitution).

Definition copy
  (ctxt : t) (from : Tezos_protocol_environment_alpha__Environment.Context.key)
  (to_ : Tezos_protocol_environment_alpha__Environment.Context.key)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult t) :=
  op_gtgteq (Context.copy (t.context ctxt) from to_)
    (fun function_parameter =>
      match function_parameter with
      | None =>
        storage_error
          (Missing_key from
            (* ❌ Variants not supported *)
            variant)
      | Some context =>
        __return
          (* ❌ Record substitution not handled *)
          record_substitution
      end).

Definition fold {A : Set}
  (ctxt : t) (k : Tezos_protocol_environment_alpha__Environment.Context.key)
  (init : A)
  (f :
    (* `Dir *) Tezos_protocol_environment_alpha__Environment.Context.key +
      (* `Key *) Tezos_protocol_environment_alpha__Environment.Context.key ->
    A -> Tezos_protocol_environment_alpha__Environment.Lwt.t A)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t A :=
  Context.fold (t.context ctxt) k init f.

Definition keys
  (ctxt : t) (k : Tezos_protocol_environment_alpha__Environment.Context.key)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (list Tezos_protocol_environment_alpha__Environment.Context.key) :=
  Context.keys (t.context ctxt) k.

Definition fold_keys {A : Set}
  (ctxt : t) (k : Tezos_protocol_environment_alpha__Environment.Context.key)
  (init : A)
  (f :
    Tezos_protocol_environment_alpha__Environment.Context.key -> A ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t A)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t A :=
  Context.fold_keys (t.context ctxt) k init f.

Definition project {A : Set} (x : A) : A := x.

Definition absolute_key {A B : Set} (function_parameter : A) : B -> B :=
  let '_ := function_parameter in
  fun k => k.

Definition description {A : Set}
  : Tezos_raw_protocol_alpha.Storage_description.t A :=
  Storage_description.create tt.

Definition fresh_temporary_big_map (ctxt : t)
  : t * Tezos_protocol_environment_alpha__Environment.Z.t :=
  ((* ❌ Record substitution not handled *)
  record_substitution, (t.temporary_big_map ctxt)).

Definition reset_temporary_big_map (ctxt : t) : t :=
  (* ❌ Record substitution not handled *)
  record_substitution.

Definition temporary_big_maps {A : Set}
  (ctxt : t)
  (f :
    A -> Tezos_protocol_environment_alpha__Environment.Z.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t A) (acc : A)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t A :=
  let fix iter
    (acc : A) (id : Tezos_protocol_environment_alpha__Environment.Z.t)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t A :=
    if Z.equal id (t.temporary_big_map ctxt) then
      Lwt.__return acc
    else
      op_gtgteq (f acc id) (fun acc => iter acc (Z.sub id Z.one)) in
  iter acc (Z.sub Z.zero Z.one).

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

(** {1 Errors} *)

type error += Too_many_internal_operations (* `Permanent *)

(** An internal storage error that should not happen *)
type storage_error =
  | Incompatible_protocol_version of string
  | Missing_key of string list * [`Get | `Set | `Del | `Copy]
  | Existing_key of string list
  | Corrupted_data of string list

type error += Storage_error of storage_error

type error += Failed_to_parse_parameter of MBytes.t

type error += Failed_to_decode_parameter of Data_encoding.json * string

val storage_error : storage_error -> 'a tzresult Lwt.t

(** {1 Abstract Context} *)

(** Abstract view of the context.
    Includes a handle to the functional key-value database
    ({!Context.t}) along with some in-memory values (gas, etc.). *)
type t

type context = t

type root_context = t

(** Retrieves the state of the database and gives its abstract view.
    It also returns wether this is the first block validated
    with this version of the protocol. *)
val prepare :
  level:Int32.t ->
  predecessor_timestamp:Time.t ->
  timestamp:Time.t ->
  fitness:Fitness.t ->
  Context.t ->
  context tzresult Lwt.t

type previous_protocol = Genesis of Parameters_repr.t | Alpha_previous

val prepare_first_block :
  level:int32 ->
  timestamp:Time.t ->
  fitness:Fitness.t ->
  Context.t ->
  (previous_protocol * context) tzresult Lwt.t

val activate : context -> Protocol_hash.t -> t Lwt.t

val fork_test_chain : context -> Protocol_hash.t -> Time.t -> t Lwt.t

(** Returns the state of the database resulting of operations on its
    abstract view *)
val recover : context -> Context.t

val current_level : context -> Level_repr.t

val predecessor_timestamp : context -> Time.t

val current_timestamp : context -> Time.t

val current_fitness : context -> Int64.t

val set_current_fitness : context -> Int64.t -> t

val constants : context -> Constants_repr.parametric

val patch_constants :
  context ->
  (Constants_repr.parametric -> Constants_repr.parametric) ->
  context Lwt.t

val first_level : context -> Raw_level_repr.t

(** Increment the current block fee stash that will be credited to baker's
    frozen_fees account at finalize_application *)
val add_fees : context -> Tez_repr.t -> context tzresult Lwt.t

(** Increment the current block reward stash that will be credited to baker's
    frozen_fees account at finalize_application *)
val add_rewards : context -> Tez_repr.t -> context tzresult Lwt.t

(** Increment the current block deposit stash for a specific delegate. All the
    delegates' frozen_deposit accounts are credited at finalize_application *)
val add_deposit :
  context ->
  Signature.Public_key_hash.t ->
  Tez_repr.t ->
  context tzresult Lwt.t

val get_fees : context -> Tez_repr.t

val get_rewards : context -> Tez_repr.t

val get_deposits : context -> Tez_repr.t Signature.Public_key_hash.Map.t

type error += Gas_limit_too_high (* `Permanent *)

val check_gas_limit : t -> Z.t -> unit tzresult

val set_gas_limit : t -> Z.t -> t

val set_gas_unlimited : t -> t

val gas_level : t -> Gas_limit_repr.t

val gas_consumed : since:t -> until:t -> Z.t

val block_gas_level : t -> Z.t

val init_storage_space_to_pay : t -> t

val update_storage_space_to_pay : t -> Z.t -> t

val update_allocated_contracts_count : t -> t

val clear_storage_space_to_pay : t -> t * Z.t * int

type error += Undefined_operation_nonce (* `Permanent *)

val init_origination_nonce : t -> Operation_hash.t -> t

val origination_nonce : t -> Contract_repr.origination_nonce tzresult

val increment_origination_nonce :
  t -> (t * Contract_repr.origination_nonce) tzresult

val unset_origination_nonce : t -> t

(** {1 Generic accessors} *)

type key = string list

type value = MBytes.t

(** All context manipulation functions. This signature is included
    as-is for direct context accesses, and used in {!Storage_functors}
    to provide restricted views to the context. *)
module type T = sig
  type t

  type context = t

  (** Tells if the key is already defined as a value. *)
  val mem : context -> key -> bool Lwt.t

  (** Tells if the key is already defined as a directory. *)
  val dir_mem : context -> key -> bool Lwt.t

  (** Retrieve the value from the storage bucket ; returns a
      {!Storage_error Missing_key} if the key is not set. *)
  val get : context -> key -> value tzresult Lwt.t

  (** Retrieves the value from the storage bucket ; returns [None] if
      the data is not initialized. *)
  val get_option : context -> key -> value option Lwt.t

  (** Allocates the storage bucket and initializes it ; returns a
      {!Storage_error Existing_key} if the bucket exists. *)
  val init : context -> key -> value -> context tzresult Lwt.t

  (** Updates the content of the bucket ; returns a {!Storage_error
      Missing_key} if the value does not exists. *)
  val set : context -> key -> value -> context tzresult Lwt.t

  (** Allocates the data and initializes it with a value ; just
      updates it if the bucket exists. *)
  val init_set : context -> key -> value -> context Lwt.t

  (** When the value is [Some v], allocates the data and initializes
      it with [v] ; just updates it if the bucket exists. When the
      valus is [None], delete the storage bucket when the value ; does
      nothing if the bucket does not exists. *)
  val set_option : context -> key -> value option -> context Lwt.t

  (** Delete the storage bucket ; returns a {!Storage_error
      Missing_key} if the bucket does not exists. *)
  val delete : context -> key -> context tzresult Lwt.t

  (** Removes the storage bucket and its contents ; does nothing if the
      bucket does not exists. *)
  val remove : context -> key -> context Lwt.t

  (** Recursively removes all the storage buckets and contents ; does
      nothing if no bucket exists. *)
  val remove_rec : context -> key -> context Lwt.t

  val copy : context -> from:key -> to_:key -> context tzresult Lwt.t

  (** Iterator on all the items of a given directory. *)
  val fold :
    context ->
    key ->
    init:'a ->
    f:([`Key of key | `Dir of key] -> 'a -> 'a Lwt.t) ->
    'a Lwt.t

  (** Recursively list all subkeys of a given key. *)
  val keys : context -> key -> key list Lwt.t

  (** Recursive iterator on all the subkeys of a given key. *)
  val fold_keys :
    context -> key -> init:'a -> f:(key -> 'a -> 'a Lwt.t) -> 'a Lwt.t

  (** Internally used in {!Storage_functors} to escape from a view. *)
  val project : context -> root_context

  (** Internally used in {!Storage_functors} to retrieve a full key
      from partial key relative a view. *)
  val absolute_key : context -> key -> key

  (** Internally used in {!Storage_functors} to consume gas from
      within a view. *)
  val consume_gas : context -> Gas_limit_repr.cost -> context tzresult

  (** Check if consume_gas will fail *)
  val check_enough_gas : context -> Gas_limit_repr.cost -> unit tzresult

  val description : context Storage_description.t
end

include T with type t := t and type context := context

(** Initialize the local nonce used for preventing a script to
    duplicate an internal operation to replay it. *)
val reset_internal_nonce : context -> context

(** Increments the internal operation nonce. *)
val fresh_internal_nonce : context -> (context * int) tzresult

(** Mark an internal operation nonce as taken. *)
val record_internal_nonce : context -> int -> context

(** Check is the internal operation nonce has been taken. *)
val internal_nonce_already_recorded : context -> int -> bool

(** Returns a map where to each endorser's pkh is associated the list of its
    endorsing slots (in decreasing order) for a given level. *)
val allowed_endorsements :
  context ->
  (Signature.Public_key.t * int list * bool) Signature.Public_key_hash.Map.t

(** Keep track of the number of endorsements that are included in a block *)
val included_endorsements : context -> int

(** Initializes the map of allowed endorsements, this function must only be
    called once. *)
val init_endorsements :
  context ->
  (Signature.Public_key.t * int list * bool) Signature.Public_key_hash.Map.t ->
  context

(** Marks an endorsment in the map as used. *)
val record_endorsement : context -> Signature.Public_key_hash.t -> context

(** Provide a fresh identifier for a temporary big map (negative index). *)
val fresh_temporary_big_map : context -> context * Z.t

(** Reset the temporary big_map identifier generator to [-1]. *)
val reset_temporary_big_map : context -> context

(** Iterate over all created temporary big maps since the last {!reset_temporary_big_map}. *)
val temporary_big_maps : context -> ('a -> Z.t -> 'a Lwt.t) -> 'a -> 'a Lwt.t

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

(* extensible_type Tezos_protocol_environment_alpha__Environment.Error_monad.error *)

Inductive storage_error : Set :=
| Incompatible_protocol_version : string -> storage_error
| Missing_key :
  list string ->
  (* `Del *) unit + (* `Copy *) unit + (* `Get *) unit + (* `Set *) unit ->
  storage_error
| Existing_key : list string -> storage_error
| Corrupted_data : list string -> storage_error.

(* extensible_type Tezos_protocol_environment_alpha__Environment.Error_monad.error *)

(* extensible_type Tezos_protocol_environment_alpha__Environment.Error_monad.error *)

(* extensible_type Tezos_protocol_environment_alpha__Environment.Error_monad.error *)

Parameter storage_error : forall {a : Set},
  storage_error ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult a).

Parameter t : Set.

Definition context := t.

Definition root_context := t.

Parameter prepare :
  Tezos_protocol_environment_alpha__Environment.Int32.t ->
  Tezos_protocol_environment_alpha__Environment.Time.t ->
  Tezos_protocol_environment_alpha__Environment.Time.t ->
  Tezos_protocol_environment_alpha__Environment.Fitness.t ->
  Tezos_protocol_environment_alpha__Environment.Context.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult context).

Inductive previous_protocol : Set :=
| Genesis : Tezos_raw_protocol_alpha.Parameters_repr.t -> previous_protocol
| Alpha_previous : previous_protocol.

Parameter prepare_first_block :
  int32 -> Tezos_protocol_environment_alpha__Environment.Time.t ->
  Tezos_protocol_environment_alpha__Environment.Fitness.t ->
  Tezos_protocol_environment_alpha__Environment.Context.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (previous_protocol * context)).

Parameter activate :
  context -> Tezos_protocol_environment_alpha__Environment.Protocol_hash.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t t.

Parameter fork_test_chain :
  context -> Tezos_protocol_environment_alpha__Environment.Protocol_hash.t ->
  Tezos_protocol_environment_alpha__Environment.Time.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t t.

Parameter recover :
  context -> Tezos_protocol_environment_alpha__Environment.Context.t.

Parameter current_level : context -> Tezos_raw_protocol_alpha.Level_repr.t.

Parameter predecessor_timestamp :
  context -> Tezos_protocol_environment_alpha__Environment.Time.t.

Parameter current_timestamp :
  context -> Tezos_protocol_environment_alpha__Environment.Time.t.

Parameter current_fitness :
  context -> Tezos_protocol_environment_alpha__Environment.Int64.t.

Parameter set_current_fitness :
  context -> Tezos_protocol_environment_alpha__Environment.Int64.t -> t.

Parameter constants :
  context -> Tezos_raw_protocol_alpha.Constants_repr.parametric.

Parameter patch_constants :
  context ->
  (Tezos_raw_protocol_alpha.Constants_repr.parametric ->
  Tezos_raw_protocol_alpha.Constants_repr.parametric) ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t context.

Parameter first_level : context -> Tezos_raw_protocol_alpha.Raw_level_repr.t.

Parameter add_fees :
  context -> Tezos_raw_protocol_alpha.Tez_repr.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult context).

Parameter add_rewards :
  context -> Tezos_raw_protocol_alpha.Tez_repr.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult context).

Parameter add_deposit :
  context ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Tezos_raw_protocol_alpha.Tez_repr.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult context).

Parameter get_fees : context -> Tezos_raw_protocol_alpha.Tez_repr.t.

Parameter get_rewards : context -> Tezos_raw_protocol_alpha.Tez_repr.t.

Parameter get_deposits :
  context ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.Map.t
    Tezos_raw_protocol_alpha.Tez_repr.t.

(* extensible_type Tezos_protocol_environment_alpha__Environment.Error_monad.error *)

Parameter check_gas_limit :
  t -> Tezos_protocol_environment_alpha__Environment.Z.t ->
  Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit.

Parameter set_gas_limit :
  t -> Tezos_protocol_environment_alpha__Environment.Z.t -> t.

Parameter set_gas_unlimited : t -> t.

Parameter gas_level : t -> Tezos_raw_protocol_alpha.Gas_limit_repr.t.

Parameter gas_consumed :
  t -> t -> Tezos_protocol_environment_alpha__Environment.Z.t.

Parameter block_gas_level :
  t -> Tezos_protocol_environment_alpha__Environment.Z.t.

Parameter init_storage_space_to_pay : t -> t.

Parameter update_storage_space_to_pay :
  t -> Tezos_protocol_environment_alpha__Environment.Z.t -> t.

Parameter update_allocated_contracts_count : t -> t.

Parameter clear_storage_space_to_pay :
  t -> t * Tezos_protocol_environment_alpha__Environment.Z.t * Z.

(* extensible_type Tezos_protocol_environment_alpha__Environment.Error_monad.error *)

Parameter init_origination_nonce :
  t -> Tezos_protocol_environment_alpha__Environment.Operation_hash.t -> t.

Parameter origination_nonce :
  t ->
  Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    Tezos_raw_protocol_alpha.Contract_repr.origination_nonce.

Parameter increment_origination_nonce :
  t ->
  Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (t * Tezos_raw_protocol_alpha.Contract_repr.origination_nonce).

Parameter unset_origination_nonce : t -> t.

Definition key := list string.

Definition value := Tezos_protocol_environment_alpha__Environment.MBytes.t.

Module T.
  Record signature {t : Set} := {
    t := t;
    context := t;
    mem :
      context -> key -> Tezos_protocol_environment_alpha__Environment.Lwt.t bool;
    dir_mem :
      context -> key -> Tezos_protocol_environment_alpha__Environment.Lwt.t bool;
    get :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          value);
    get_option :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t (option value);
    init :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          context);
    set :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          context);
    init_set :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t context;
    set_option :
      context -> key -> option value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t context;
    delete :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          context);
    remove :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t context;
    remove_rec :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t context;
    copy :
      context -> key -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          context);
    fold : forall {a : Set},
      context -> key -> a ->
      ((* `Dir *) key + (* `Key *) key -> a ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a;
    keys :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t (list key);
    fold_keys : forall {a : Set},
      context -> key -> a ->
      (key -> a -> Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a;
    project : context -> root_context;
    absolute_key : context -> key -> key;
    consume_gas :
      context -> Tezos_raw_protocol_alpha.Gas_limit_repr.cost ->
      Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult context;
    check_enough_gas :
      context -> Tezos_raw_protocol_alpha.Gas_limit_repr.cost ->
      Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit;
    description : Tezos_raw_protocol_alpha.Storage_description.t context;
  }.
  Arguments signature : clear implicits.
End T.

Parameter mem :
  context -> key -> Tezos_protocol_environment_alpha__Environment.Lwt.t bool.

Parameter dir_mem :
  context -> key -> Tezos_protocol_environment_alpha__Environment.Lwt.t bool.

Parameter get :
  context -> key ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult value).

Parameter get_option :
  context -> key ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t (option value).

Parameter init :
  context -> key -> value ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult context).

Parameter set :
  context -> key -> value ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult context).

Parameter init_set :
  context -> key -> value ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t context.

Parameter set_option :
  context -> key -> option value ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t context.

Parameter delete :
  context -> key ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult context).

Parameter remove :
  context -> key -> Tezos_protocol_environment_alpha__Environment.Lwt.t context.

Parameter remove_rec :
  context -> key -> Tezos_protocol_environment_alpha__Environment.Lwt.t context.

Parameter copy :
  context -> key -> key ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult context).

Parameter fold : forall {a : Set},
  context -> key -> a ->
  ((* `Dir *) key + (* `Key *) key -> a ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t a.

Parameter keys :
  context -> key ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t (list key).

Parameter fold_keys : forall {a : Set},
  context -> key -> a ->
  (key -> a -> Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t a.

Parameter project : context -> root_context.

Parameter absolute_key : context -> key -> key.

Parameter consume_gas :
  context -> Tezos_raw_protocol_alpha.Gas_limit_repr.cost ->
  Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult context.

Parameter check_enough_gas :
  context -> Tezos_raw_protocol_alpha.Gas_limit_repr.cost ->
  Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit.

Parameter description : Tezos_raw_protocol_alpha.Storage_description.t context.

Parameter reset_internal_nonce : context -> context.

Parameter fresh_internal_nonce :
  context ->
  Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (context * Z).

Parameter record_internal_nonce : context -> Z -> context.

Parameter internal_nonce_already_recorded : context -> Z -> bool.

Parameter allowed_endorsements :
  context ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.Map.t
    (Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t *
      list Z * bool).

Parameter included_endorsements : context -> Z.

Parameter init_endorsements :
  context ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.Map.t
    (Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t *
      list Z * bool) -> context.

Parameter record_endorsement :
  context ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  context.

Parameter fresh_temporary_big_map :
  context -> context * Tezos_protocol_environment_alpha__Environment.Z.t.

Parameter reset_temporary_big_map : context -> context.

Parameter temporary_big_maps : forall {a : Set},
  context ->
  (a -> Tezos_protocol_environment_alpha__Environment.Z.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t a) -> a ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t a.

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

type t = int32

type raw_level = t

include (Compare.Int32 : Compare.S with type t := t)

let encoding = Data_encoding.int32

let pp ppf level = Format.fprintf ppf "%ld" level

let rpc_arg =
  let construct raw_level = Int32.to_string raw_level in
  let destruct str =
    match Int32.of_string str with
    | exception _ ->
        Error "Cannot parse level"
    | raw_level ->
        Ok raw_level
  in
  RPC_arg.make
    ~descr:"A level integer"
    ~name:"block_level"
    ~construct
    ~destruct
    ()

let root = 0l

let succ = Int32.succ

let pred l = if l = 0l then None else Some (Int32.pred l)

let diff = Int32.sub

let to_int32 l = l

let of_int32_exn l =
  if Compare.Int32.(l >= 0l) then l else invalid_arg "Level_repr.of_int32"

type error += Unexpected_level of Int32.t (* `Permanent *)

let () =
  register_error_kind
    `Permanent
    ~id:"unexpected_level"
    ~title:"Unexpected level"
    ~description:"Level must be non-negative."
    ~pp:(fun ppf l ->
      Format.fprintf
        ppf
        "The level is %s but should be non-negative."
        (Int32.to_string l))
    Data_encoding.(obj1 (req "level" int32))
    (function Unexpected_level l -> Some l | _ -> None)
    (fun l -> Unexpected_level l)

let of_int32 l = try Ok (of_int32_exn l) with _ -> error (Unexpected_level l)

module Index = struct
  type t = raw_level

  let path_length = 1

  let to_path level l = Int32.to_string level :: l

  let of_path = function
    | [s] -> (
      try Some (Int32.of_string s) with _ -> None )
    | _ ->
        None

  let rpc_arg = rpc_arg

  let encoding = encoding

  let compare = compare
end

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Definition t := int32.

Definition raw_level := t.

Export Compare.Int32.

Definition encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding int32 :=
  Data_encoding.__int32_value.

Definition pp
  (ppf : Tezos_protocol_environment_alpha__Environment.Format.formatter)
  (level : int32) : unit :=
  Format.fprintf ppf
    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int32
        Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int_d
        Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
        Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_precision
        Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
      "%ld" % string) level.

Definition rpc_arg
  : Tezos_protocol_environment_alpha__Environment.RPC_arg.arg int32 :=
  let construct (raw_level : int32) : string :=
    Int32.to_string raw_level in
  let destruct (str : string)
    : Tezos_protocol_environment_alpha__Environment.Pervasives.result int32
      string :=
    let 'raw_level := Int32.of_string str in
    Tezos_protocol_environment_alpha__Environment.Pervasives.Ok raw_level in
  RPC_arg.make (Some "A level integer" % string) "block_level" % string destruct
    construct tt.

Definition root : int32 :=
  (* ❌ Constant of type int32 is converted to int *)
  0.

Definition succ : int32 -> int32 := Int32.succ.

Definition pred (l : t) : option int32 :=
  if
    op_eq l
      (* ❌ Constant of type int32 is converted to int *)
      0 then
    None
  else
    Some (Int32.pred l).

Definition diff : int32 -> int32 -> int32 := Int32.sub.

Definition to_int32 {A : Set} (l : A) : A := l.

Definition of_int32_exn
  (l : Tezos_protocol_environment_alpha__Environment.Compare.Int32.t)
  : Tezos_protocol_environment_alpha__Environment.Compare.Int32.t :=
  if
    op_gteq l
      (* ❌ Constant of type int32 is converted to int *)
      0 then
    l
  else
    invalid_arg "Level_repr.of_int32" % string.

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Top-level evaluations are considered as an error as sources of side-effects *)
Compute
  register_error_kind
    (* ❌ Variants not supported *)
    variant "unexpected_level" % string "Unexpected level" % string
    "Level must be non-negative." % string
    (Some
      (fun ppf =>
        fun l =>
          Format.fprintf ppf
            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                "The level is " % string
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                    " but should be non-negative." % string
                    Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))
              "The level is %s but should be non-negative." % string)
            (Int32.to_string l)))
    (obj1 (req None None "level" % string __int32_value))
    (fun function_parameter =>
      match function_parameter with
      |
        Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_level
          l => Some l
      | _ => None
      end)
    (fun l =>
      Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_level
        l).

Definition of_int32
  (l : Tezos_protocol_environment_alpha__Environment.Compare.Int32.t)
  : Tezos_protocol_environment_alpha__Environment.Pervasives.result
    Tezos_protocol_environment_alpha__Environment.Compare.Int32.t
    (list Tezos_protocol_environment_alpha__Environment.Error_monad.__error) :=
  (* ❌ Try-with are not handled *)
  try
    (Tezos_protocol_environment_alpha__Environment.Pervasives.Ok
      (of_int32_exn l)).

Module Index.
  Definition t := raw_level.
  
  Definition path_length : Z := 1.
  
  Definition to_path (level : int32) (l : list string) : list string :=
    cons (Int32.to_string level) l.
  
  Definition of_path (function_parameter : list string) : option int32 :=
    match function_parameter with
    | cons s [] =>
      (* ❌ Try-with are not handled *)
      try (Some (Int32.of_string s))
    | _ => None
    end.
  
  Definition rpc_arg
    : Tezos_protocol_environment_alpha__Environment.RPC_arg.arg int32 := rpc_arg.
  
  Definition encoding
    : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding int32 :=
    encoding.
  
  Definition compare : t -> t -> Z := compare.
End Index.

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

(** The shell's notion of a level: an integer indicating the number of blocks
    since genesis: genesis is 0, all other blocks have increasing levels from
    there. *)
type t

type raw_level = t

val encoding : raw_level Data_encoding.t

val rpc_arg : raw_level RPC_arg.arg

val pp : Format.formatter -> raw_level -> unit

include Compare.S with type t := raw_level

val to_int32 : raw_level -> int32

val of_int32_exn : int32 -> raw_level

val of_int32 : int32 -> raw_level tzresult

val diff : raw_level -> raw_level -> int32

val root : raw_level

val succ : raw_level -> raw_level

val pred : raw_level -> raw_level option

module Index : Storage_description.INDEX with type t = raw_level

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Parameter t : Set.

Definition raw_level := t.

Parameter encoding :
  Tezos_protocol_environment_alpha__Environment.Data_encoding.t raw_level.

Parameter rpc_arg :
  Tezos_protocol_environment_alpha__Environment.RPC_arg.arg raw_level.

Parameter pp :
  Tezos_protocol_environment_alpha__Environment.Format.formatter -> raw_level ->
  unit.

Parameter op_eq : raw_level -> raw_level -> bool.

Parameter op_ltgt : raw_level -> raw_level -> bool.

Parameter op_lt : raw_level -> raw_level -> bool.

Parameter op_lteq : raw_level -> raw_level -> bool.

Parameter op_gteq : raw_level -> raw_level -> bool.

Parameter op_gt : raw_level -> raw_level -> bool.

Parameter compare : raw_level -> raw_level -> Z.

Parameter equal : raw_level -> raw_level -> bool.

Parameter max : raw_level -> raw_level -> raw_level.

Parameter min : raw_level -> raw_level -> raw_level.

Parameter to_int32 : raw_level -> int32.

Parameter of_int32_exn : int32 -> raw_level.

Parameter of_int32 :
  int32 ->
  Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult raw_level.

Parameter diff : raw_level -> raw_level -> int32.

Parameter root : raw_level.

Parameter succ : raw_level -> raw_level.

Parameter pred : raw_level -> option raw_level.

Module Index.
  Definition t := raw_level.
  
  Parameter path_length : Z.
  
  Parameter to_path : t -> list string -> list string.
  
  Parameter of_path : list string -> option t.
  
  Parameter rpc_arg : Tezos_protocol_environment_alpha__Environment.RPC_arg.t t.
  
  Parameter encoding :
    Tezos_protocol_environment_alpha__Environment.Data_encoding.t t.
  
  Parameter compare : t -> t -> Z.
End Index.

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

include Compare.Int32

type roll = t

let encoding = Data_encoding.int32

let first = 0l

let succ i = Int32.succ i

let random sequence ~bound = Seed_repr.take_int32 sequence bound

let rpc_arg = RPC_arg.like RPC_arg.int32 "roll"

let to_int32 v = v

module Index = struct
  type t = roll

  let path_length = 3

  let to_path roll l =
    (Int32.to_string @@ Int32.logand roll (Int32.of_int 0xff))
    :: ( Int32.to_string
       @@ Int32.logand (Int32.shift_right_logical roll 8) (Int32.of_int 0xff)
       )
    :: Int32.to_string roll :: l

  let of_path = function
    | _ :: _ :: s :: _ -> (
      try Some (Int32.of_string s) with _ -> None )
    | _ ->
        None

  let rpc_arg = rpc_arg

  let encoding = encoding

  let compare = compare
end

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Export Compare.Int32.

Definition roll := t.

Definition encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding int32 :=
  Data_encoding.__int32_value.

Definition first : int32 :=
  (* ❌ Constant of type int32 is converted to int *)
  0.

Definition succ (i : int32) : int32 := Int32.succ i.

Definition random
  (sequence : Tezos_raw_protocol_alpha.Seed_repr.sequence) (bound : int32)
  : int32 * Tezos_raw_protocol_alpha.Seed_repr.sequence :=
  Seed_repr.take_int32 sequence bound.

Definition rpc_arg
  : Tezos_protocol_environment_alpha__Environment.RPC_arg.arg int32 :=
  RPC_arg.like RPC_arg.__int32_value None "roll" % string.

Definition to_int32 {A : Set} (v : A) : A := v.

Module Index.
  Definition t := roll.
  
  Definition path_length : Z := 3.
  
  Definition to_path (roll : int32) (l : list string) : list string :=
    cons (op_atat Int32.to_string (Int32.logand roll (Int32.of_int 255)))
      (cons
        (op_atat Int32.to_string
          (Int32.logand (Int32.shift_right_logical roll 8) (Int32.of_int 255)))
        (cons (Int32.to_string roll) l)).
  
  Definition of_path (function_parameter : list string) : option int32 :=
    match function_parameter with
    | cons _ (cons _ (cons s _)) =>
      (* ❌ Try-with are not handled *)
      try (Some (Int32.of_string s))
    | _ => None
    end.
  
  Definition rpc_arg
    : Tezos_protocol_environment_alpha__Environment.RPC_arg.arg int32 := rpc_arg.
  
  Definition encoding
    : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding int32 :=
    encoding.
  
  Definition compare : t -> t -> Z := compare.
End Index.

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

type t = private int32

type roll = t

val encoding : roll Data_encoding.t

val rpc_arg : roll RPC_arg.t

val random : Seed_repr.sequence -> bound:roll -> roll * Seed_repr.sequence

val first : roll

val succ : roll -> roll

val to_int32 : roll -> Int32.t

val ( = ) : roll -> roll -> bool

module Index : Storage_description.INDEX with type t = roll

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Definition t := int32.

Definition roll := t.

Parameter encoding :
  Tezos_protocol_environment_alpha__Environment.Data_encoding.t roll.

Parameter rpc_arg :
  Tezos_protocol_environment_alpha__Environment.RPC_arg.t roll.

Parameter random :
  Tezos_raw_protocol_alpha.Seed_repr.sequence -> roll ->
  roll * Tezos_raw_protocol_alpha.Seed_repr.sequence.

Parameter first : roll.

Parameter succ : roll -> roll.

Parameter to_int32 :
  roll -> Tezos_protocol_environment_alpha__Environment.Int32.t.

Parameter op_eq : roll -> roll -> bool.

Module Index.
  Definition t := roll.
  
  Parameter path_length : Z.
  
  Parameter to_path : t -> list string -> list string.
  
  Parameter of_path : list string -> option t.
  
  Parameter rpc_arg : Tezos_protocol_environment_alpha__Environment.RPC_arg.t t.
  
  Parameter encoding :
    Tezos_protocol_environment_alpha__Environment.Data_encoding.t t.
  
  Parameter compare : t -> t -> Z.
End Index.

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Misc

type error +=
  | Consume_roll_change (* `Permanent *)
  | No_roll_for_delegate (* `Permanent *)
  | No_roll_snapshot_for_cycle of Cycle_repr.t (* `Permanent *)
  | Unregistered_delegate of Signature.Public_key_hash.t

(* `Permanent *)

let () =
  let open Data_encoding in
  (* Consume roll change *)
  register_error_kind
    `Permanent
    ~id:"contract.manager.consume_roll_change"
    ~title:"Consume roll change"
    ~description:"Change is not enough to consume a roll."
    ~pp:(fun ppf () ->
      Format.fprintf ppf "Not enough change to consume a roll.")
    empty
    (function Consume_roll_change -> Some () | _ -> None)
    (fun () -> Consume_roll_change) ;
  (* No roll for delegate *)
  register_error_kind
    `Permanent
    ~id:"contract.manager.no_roll_for_delegate"
    ~title:"No roll for delegate"
    ~description:"Delegate has no roll."
    ~pp:(fun ppf () -> Format.fprintf ppf "Delegate has no roll.")
    empty
    (function No_roll_for_delegate -> Some () | _ -> None)
    (fun () -> No_roll_for_delegate) ;
  (* No roll snapshot for cycle *)
  register_error_kind
    `Permanent
    ~id:"contract.manager.no_roll_snapshot_for_cycle"
    ~title:"No roll snapshot for cycle"
    ~description:
      "A snapshot of the rolls distribution does not exist for this cycle."
    ~pp:(fun ppf c ->
      Format.fprintf
        ppf
        "A snapshot of the rolls distribution does not exist for cycle %a"
        Cycle_repr.pp
        c)
    (obj1 (req "cycle" Cycle_repr.encoding))
    (function No_roll_snapshot_for_cycle c -> Some c | _ -> None)
    (fun c -> No_roll_snapshot_for_cycle c) ;
  (* Unregistered delegate *)
  register_error_kind
    `Permanent
    ~id:"contract.manager.unregistered_delegate"
    ~title:"Unregistered delegate"
    ~description:"A contract cannot be delegated to an unregistered delegate"
    ~pp:(fun ppf k ->
      Format.fprintf
        ppf
        "The provided public key (with hash %a) is  not registered as valid \
         delegate key."
        Signature.Public_key_hash.pp
        k)
    (obj1 (req "hash" Signature.Public_key_hash.encoding))
    (function Unregistered_delegate k -> Some k | _ -> None)
    (fun k -> Unregistered_delegate k)

let get_contract_delegate c contract =
  Storage.Contract.Delegate.get_option c contract

let delegate_pubkey ctxt delegate =
  Storage.Contract.Manager.get_option
    ctxt
    (Contract_repr.implicit_contract delegate)
  >>=? function
  | None | Some (Manager_repr.Hash _) ->
      fail (Unregistered_delegate delegate)
  | Some (Manager_repr.Public_key pk) ->
      return pk

let clear_cycle c cycle =
  Storage.Roll.Snapshot_for_cycle.get c cycle
  >>=? fun index ->
  Storage.Roll.Snapshot_for_cycle.delete c cycle
  >>=? fun c ->
  Storage.Roll.Last_for_snapshot.delete (c, cycle) index
  >>=? fun c ->
  Storage.Roll.Owner.delete_snapshot c (cycle, index) >>= fun c -> return c

let fold ctxt ~f init =
  Storage.Roll.Next.get ctxt
  >>=? fun last ->
  let rec loop ctxt roll acc =
    acc
    >>=? fun acc ->
    if Roll_repr.(roll = last) then return acc
    else
      Storage.Roll.Owner.get_option ctxt roll
      >>=? function
      | None ->
          loop ctxt (Roll_repr.succ roll) (return acc)
      | Some delegate ->
          loop ctxt (Roll_repr.succ roll) (f roll delegate acc)
  in
  loop ctxt Roll_repr.first (return init)

let snapshot_rolls_for_cycle ctxt cycle =
  Storage.Roll.Snapshot_for_cycle.get ctxt cycle
  >>=? fun index ->
  Storage.Roll.Snapshot_for_cycle.set ctxt cycle (index + 1)
  >>=? fun ctxt ->
  Storage.Roll.Owner.snapshot ctxt (cycle, index)
  >>=? fun ctxt ->
  Storage.Roll.Next.get ctxt
  >>=? fun last ->
  Storage.Roll.Last_for_snapshot.init (ctxt, cycle) index last
  >>=? fun ctxt -> return ctxt

let freeze_rolls_for_cycle ctxt cycle =
  Storage.Roll.Snapshot_for_cycle.get ctxt cycle
  >>=? fun max_index ->
  Storage.Seed.For_cycle.get ctxt cycle
  >>=? fun seed ->
  let rd = Seed_repr.initialize_new seed [MBytes.of_string "roll_snapshot"] in
  let seq = Seed_repr.sequence rd 0l in
  let selected_index =
    Seed_repr.take_int32 seq (Int32.of_int max_index) |> fst |> Int32.to_int
  in
  Storage.Roll.Snapshot_for_cycle.set ctxt cycle selected_index
  >>=? fun ctxt ->
  fold_left_s
    (fun ctxt index ->
      if Compare.Int.(index = selected_index) then return ctxt
      else
        Storage.Roll.Owner.delete_snapshot ctxt (cycle, index)
        >>= fun ctxt ->
        Storage.Roll.Last_for_snapshot.delete (ctxt, cycle) index
        >>=? fun ctxt -> return ctxt)
    ctxt
    Misc.(0 --> (max_index - 1))
  >>=? fun ctxt -> return ctxt

(* Roll selection *)

module Random = struct
  let int32_to_bytes i =
    let b = MBytes.create 4 in
    MBytes.set_int32 b 0 i ; b

  let level_random seed use level =
    let position = level.Level_repr.cycle_position in
    Seed_repr.initialize_new
      seed
      [MBytes.of_string ("level " ^ use ^ ":"); int32_to_bytes position]

  let owner c kind level offset =
    let cycle = level.Level_repr.cycle in
    Seed_storage.for_cycle c cycle
    >>=? fun random_seed ->
    let rd = level_random random_seed kind level in
    let sequence = Seed_repr.sequence rd (Int32.of_int offset) in
    Storage.Roll.Snapshot_for_cycle.get c cycle
    >>=? fun index ->
    Storage.Roll.Last_for_snapshot.get (c, cycle) index
    >>=? fun bound ->
    let rec loop sequence =
      let (roll, sequence) = Roll_repr.random sequence ~bound in
      Storage.Roll.Owner.Snapshot.get_option c ((cycle, index), roll)
      >>=? function None -> loop sequence | Some delegate -> return delegate
    in
    Storage.Roll.Owner.snapshot_exists c (cycle, index)
    >>= fun snapshot_exists ->
    fail_unless snapshot_exists (No_roll_snapshot_for_cycle cycle)
    >>=? fun () -> loop sequence
end

let baking_rights_owner c level ~priority =
  Random.owner c "baking" level priority

let endorsement_rights_owner c level ~slot =
  Random.owner c "endorsement" level slot

let traverse_rolls ctxt head =
  let rec loop acc roll =
    Storage.Roll.Successor.get_option ctxt roll
    >>=? function
    | None -> return (List.rev acc) | Some next -> loop (next :: acc) next
  in
  loop [head] head

let get_rolls ctxt delegate =
  Storage.Roll.Delegate_roll_list.get_option ctxt delegate
  >>=? function
  | None -> return_nil | Some head_roll -> traverse_rolls ctxt head_roll

let count_rolls ctxt delegate =
  Storage.Roll.Delegate_roll_list.get_option ctxt delegate
  >>=? function
  | None ->
      return 0
  | Some head_roll ->
      let rec loop acc roll =
        Storage.Roll.Successor.get_option ctxt roll
        >>=? function None -> return acc | Some next -> loop (succ acc) next
      in
      loop 1 head_roll

let get_change c delegate =
  Storage.Roll.Delegate_change.get_option c delegate
  >>=? function None -> return Tez_repr.zero | Some change -> return change

module Delegate = struct
  let fresh_roll c =
    Storage.Roll.Next.get c
    >>=? fun roll ->
    Storage.Roll.Next.set c (Roll_repr.succ roll) >>=? fun c -> return (roll, c)

  let get_limbo_roll c =
    Storage.Roll.Limbo.get_option c
    >>=? function
    | None ->
        fresh_roll c
        >>=? fun (roll, c) ->
        Storage.Roll.Limbo.init c roll >>=? fun c -> return (roll, c)
    | Some roll ->
        return (roll, c)

  let consume_roll_change c delegate =
    let tokens_per_roll = Constants_storage.tokens_per_roll c in
    Storage.Roll.Delegate_change.get c delegate
    >>=? fun change ->
    trace Consume_roll_change (Lwt.return Tez_repr.(change -? tokens_per_roll))
    >>=? fun new_change ->
    Storage.Roll.Delegate_change.set c delegate new_change

  let recover_roll_change c delegate =
    let tokens_per_roll = Constants_storage.tokens_per_roll c in
    Storage.Roll.Delegate_change.get c delegate
    >>=? fun change ->
    Lwt.return Tez_repr.(change +? tokens_per_roll)
    >>=? fun new_change ->
    Storage.Roll.Delegate_change.set c delegate new_change

  let pop_roll_from_delegate c delegate =
    recover_roll_change c delegate
    >>=? fun c ->
    (* beginning:
       delegate : roll -> successor_roll -> ...
       limbo : limbo_head -> ...
    *)
    Storage.Roll.Limbo.get_option c
    >>=? fun limbo_head ->
    Storage.Roll.Delegate_roll_list.get_option c delegate
    >>=? function
    | None ->
        fail No_roll_for_delegate
    | Some roll ->
        Storage.Roll.Owner.delete c roll
        >>=? fun c ->
        Storage.Roll.Successor.get_option c roll
        >>=? fun successor_roll ->
        Storage.Roll.Delegate_roll_list.set_option c delegate successor_roll
        >>= fun c ->
        (* delegate : successor_roll -> ...
           roll ------^
           limbo : limbo_head -> ... *)
        Storage.Roll.Successor.set_option c roll limbo_head
        >>= fun c ->
        (* delegate : successor_roll -> ...
           roll ------v
           limbo : limbo_head -> ... *)
        Storage.Roll.Limbo.init_set c roll
        >>= fun c ->
        (* delegate : successor_roll -> ...
           limbo : roll -> limbo_head -> ... *)
        return (roll, c)

  let create_roll_in_delegate c delegate delegate_pk =
    consume_roll_change c delegate
    >>=? fun c ->
    (* beginning:
       delegate : delegate_head -> ...
       limbo : roll -> limbo_successor -> ...
    *)
    Storage.Roll.Delegate_roll_list.get_option c delegate
    >>=? fun delegate_head ->
    get_limbo_roll c
    >>=? fun (roll, c) ->
    Storage.Roll.Owner.init c roll delegate_pk
    >>=? fun c ->
    Storage.Roll.Successor.get_option c roll
    >>=? fun limbo_successor ->
    Storage.Roll.Limbo.set_option c limbo_successor
    >>= fun c ->
    (* delegate : delegate_head -> ...
       roll ------v
       limbo : limbo_successor -> ... *)
    Storage.Roll.Successor.set_option c roll delegate_head
    >>= fun c ->
    (* delegate : delegate_head -> ...
       roll ------^
       limbo : limbo_successor -> ... *)
    Storage.Roll.Delegate_roll_list.init_set c delegate roll
    >>= fun c ->
    (* delegate : roll -> delegate_head -> ...
       limbo : limbo_successor -> ... *)
    return c

  let ensure_inited c delegate =
    Storage.Roll.Delegate_change.mem c delegate
    >>= function
    | true ->
        return c
    | false ->
        Storage.Roll.Delegate_change.init c delegate Tez_repr.zero

  let is_inactive c delegate =
    Storage.Contract.Inactive_delegate.mem
      c
      (Contract_repr.implicit_contract delegate)
    >>= fun inactive ->
    if inactive then return inactive
    else
      Storage.Contract.Delegate_desactivation.get_option
        c
        (Contract_repr.implicit_contract delegate)
      >>=? function
      | Some last_active_cycle ->
          let {Level_repr.cycle = current_cycle} =
            Raw_context.current_level c
          in
          return Cycle_repr.(last_active_cycle < current_cycle)
      | None ->
          (* This case is only when called from `set_active`, when creating
             a contract. *)
          return_false

  let add_amount c delegate amount =
    ensure_inited c delegate
    >>=? fun c ->
    let tokens_per_roll = Constants_storage.tokens_per_roll c in
    Storage.Roll.Delegate_change.get c delegate
    >>=? fun change ->
    Lwt.return Tez_repr.(amount +? change)
    >>=? fun change ->
    Storage.Roll.Delegate_change.set c delegate change
    >>=? fun c ->
    delegate_pubkey c delegate
    >>=? fun delegate_pk ->
    let rec loop c change =
      if Tez_repr.(change < tokens_per_roll) then return c
      else
        Lwt.return Tez_repr.(change -? tokens_per_roll)
        >>=? fun change ->
        create_roll_in_delegate c delegate delegate_pk
        >>=? fun c -> loop c change
    in
    is_inactive c delegate
    >>=? fun inactive ->
    if inactive then return c
    else
      loop c change
      >>=? fun c ->
      Storage.Roll.Delegate_roll_list.get_option c delegate
      >>=? fun rolls ->
      match rolls with
      | None ->
          return c
      | Some _ ->
          Storage.Active_delegates_with_rolls.add c delegate
          >>= fun c -> return c

  let remove_amount c delegate amount =
    let tokens_per_roll = Constants_storage.tokens_per_roll c in
    let rec loop c change =
      if Tez_repr.(amount <= change) then return (c, change)
      else
        pop_roll_from_delegate c delegate
        >>=? fun (_, c) ->
        Lwt.return Tez_repr.(change +? tokens_per_roll)
        >>=? fun change -> loop c change
    in
    Storage.Roll.Delegate_change.get c delegate
    >>=? fun change ->
    is_inactive c delegate
    >>=? fun inactive ->
    ( if inactive then return (c, change)
    else
      loop c change
      >>=? fun (c, change) ->
      Storage.Roll.Delegate_roll_list.get_option c delegate
      >>=? fun rolls ->
      match rolls with
      | None ->
          Storage.Active_delegates_with_rolls.del c delegate
          >>= fun c -> return (c, change)
      | Some _ ->
          return (c, change) )
    >>=? fun (c, change) ->
    Lwt.return Tez_repr.(change -? amount)
    >>=? fun change -> Storage.Roll.Delegate_change.set c delegate change

  let set_inactive ctxt delegate =
    ensure_inited ctxt delegate
    >>=? fun ctxt ->
    let tokens_per_roll = Constants_storage.tokens_per_roll ctxt in
    Storage.Roll.Delegate_change.get ctxt delegate
    >>=? fun change ->
    Storage.Contract.Inactive_delegate.add
      ctxt
      (Contract_repr.implicit_contract delegate)
    >>= fun ctxt ->
    Storage.Active_delegates_with_rolls.del ctxt delegate
    >>= fun ctxt ->
    let rec loop ctxt change =
      Storage.Roll.Delegate_roll_list.get_option ctxt delegate
      >>=? function
      | None ->
          return (ctxt, change)
      | Some _roll ->
          pop_roll_from_delegate ctxt delegate
          >>=? fun (_, ctxt) ->
          Lwt.return Tez_repr.(change +? tokens_per_roll)
          >>=? fun change -> loop ctxt change
    in
    loop ctxt change
    >>=? fun (ctxt, change) ->
    Storage.Roll.Delegate_change.set ctxt delegate change
    >>=? fun ctxt -> return ctxt

  let set_active ctxt delegate =
    is_inactive ctxt delegate
    >>=? fun inactive ->
    let current_cycle = (Raw_context.current_level ctxt).cycle in
    let preserved_cycles = Constants_storage.preserved_cycles ctxt in
    (* When the delegate is new or inactive, she will become active in
       `1+preserved_cycles`, and we allow `preserved_cycles` for the
       delegate to start baking. When the delegate is active, we only
       give her at least `preserved_cycles` after the current cycle
       before to be deactivated.  *)
    Storage.Contract.Delegate_desactivation.get_option
      ctxt
      (Contract_repr.implicit_contract delegate)
    >>=? fun current_expiration ->
    let expiration =
      match current_expiration with
      | None ->
          Cycle_repr.add current_cycle (1 + (2 * preserved_cycles))
      | Some current_expiration ->
          let delay =
            if inactive then 1 + (2 * preserved_cycles)
            else 1 + preserved_cycles
          in
          let updated = Cycle_repr.add current_cycle delay in
          Cycle_repr.max current_expiration updated
    in
    Storage.Contract.Delegate_desactivation.init_set
      ctxt
      (Contract_repr.implicit_contract delegate)
      expiration
    >>= fun ctxt ->
    if not inactive then return ctxt
    else
      ensure_inited ctxt delegate
      >>=? fun ctxt ->
      let tokens_per_roll = Constants_storage.tokens_per_roll ctxt in
      Storage.Roll.Delegate_change.get ctxt delegate
      >>=? fun change ->
      Storage.Contract.Inactive_delegate.del
        ctxt
        (Contract_repr.implicit_contract delegate)
      >>= fun ctxt ->
      delegate_pubkey ctxt delegate
      >>=? fun delegate_pk ->
      let rec loop ctxt change =
        if Tez_repr.(change < tokens_per_roll) then return ctxt
        else
          Lwt.return Tez_repr.(change -? tokens_per_roll)
          >>=? fun change ->
          create_roll_in_delegate ctxt delegate delegate_pk
          >>=? fun ctxt -> loop ctxt change
      in
      loop ctxt change
      >>=? fun ctxt ->
      Storage.Roll.Delegate_roll_list.get_option ctxt delegate
      >>=? fun rolls ->
      match rolls with
      | None ->
          return ctxt
      | Some _ ->
          Storage.Active_delegates_with_rolls.add ctxt delegate
          >>= fun ctxt -> return ctxt
end

module Contract = struct
  let add_amount c contract amount =
    get_contract_delegate c contract
    >>=? function
    | None -> return c | Some delegate -> Delegate.add_amount c delegate amount

  let remove_amount c contract amount =
    get_contract_delegate c contract
    >>=? function
    | None ->
        return c
    | Some delegate ->
        Delegate.remove_amount c delegate amount
end

let init ctxt = Storage.Roll.Next.init ctxt Roll_repr.first

let init_first_cycles ctxt =
  let preserved = Constants_storage.preserved_cycles ctxt in
  (* Precompute rolls for cycle (0 --> preserved_cycles) *)
  List.fold_left
    (fun ctxt c ->
      ctxt
      >>=? fun ctxt ->
      let cycle = Cycle_repr.of_int32_exn (Int32.of_int c) in
      Storage.Roll.Snapshot_for_cycle.init ctxt cycle 0
      >>=? fun ctxt ->
      snapshot_rolls_for_cycle ctxt cycle
      >>=? fun ctxt -> freeze_rolls_for_cycle ctxt cycle)
    (return ctxt)
    (0 --> preserved)
  >>=? fun ctxt ->
  let cycle = Cycle_repr.of_int32_exn (Int32.of_int (preserved + 1)) in
  (* Precomputed a snapshot for cycle (preserved_cycles + 1) *)
  Storage.Roll.Snapshot_for_cycle.init ctxt cycle 0
  >>=? fun ctxt ->
  snapshot_rolls_for_cycle ctxt cycle
  >>=? fun ctxt ->
  (* Prepare storage for storing snapshots for cycle (preserved_cycles+2) *)
  let cycle = Cycle_repr.of_int32_exn (Int32.of_int (preserved + 2)) in
  Storage.Roll.Snapshot_for_cycle.init ctxt cycle 0
  >>=? fun ctxt -> return ctxt

let snapshot_rolls ctxt =
  let current_level = Raw_context.current_level ctxt in
  let preserved = Constants_storage.preserved_cycles ctxt in
  let cycle = Cycle_repr.add current_level.cycle (preserved + 2) in
  snapshot_rolls_for_cycle ctxt cycle

let cycle_end ctxt last_cycle =
  let preserved = Constants_storage.preserved_cycles ctxt in
  ( match Cycle_repr.sub last_cycle preserved with
  | None ->
      return ctxt
  | Some cleared_cycle ->
      clear_cycle ctxt cleared_cycle )
  >>=? fun ctxt ->
  let frozen_roll_cycle = Cycle_repr.add last_cycle (preserved + 1) in
  freeze_rolls_for_cycle ctxt frozen_roll_cycle
  >>=? fun ctxt ->
  Storage.Roll.Snapshot_for_cycle.init
    ctxt
    (Cycle_repr.succ (Cycle_repr.succ frozen_roll_cycle))
    0
  >>=? fun ctxt -> return ctxt

let update_tokens_per_roll ctxt new_tokens_per_roll =
  let constants = Raw_context.constants ctxt in
  let old_tokens_per_roll = constants.tokens_per_roll in
  Raw_context.patch_constants ctxt (fun constants ->
      {constants with Constants_repr.tokens_per_roll = new_tokens_per_roll})
  >>= fun ctxt ->
  let decrease = Tez_repr.(new_tokens_per_roll < old_tokens_per_roll) in
  ( if decrease then
    Lwt.return Tez_repr.(old_tokens_per_roll -? new_tokens_per_roll)
  else Lwt.return Tez_repr.(new_tokens_per_roll -? old_tokens_per_roll) )
  >>=? fun abs_diff ->
  Storage.Delegates.fold ctxt (Ok ctxt) (fun pkh ctxt ->
      Lwt.return ctxt
      >>=? fun ctxt ->
      count_rolls ctxt pkh
      >>=? fun rolls ->
      Lwt.return Tez_repr.(abs_diff *? Int64.of_int rolls)
      >>=? fun amount ->
      if decrease then Delegate.add_amount ctxt pkh amount
      else Delegate.remove_amount ctxt pkh amount)

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Import Misc.

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Top-level evaluations are considered as an error as sources of side-effects *)
Compute
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "contract.manager.consume_roll_change" % string
      "Consume roll change" % string
      "Change is not enough to consume a roll." % string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let 'tt := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Not enough change to consume a roll." % string
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
                "Not enough change to consume a roll." % string))) empty
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Consume_roll_change
          => Some tt
        | _ => None
        end)
      (fun function_parameter =>
        let 'tt := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Consume_roll_change)
    in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "contract.manager.no_roll_for_delegate" % string
      "No roll for delegate" % string "Delegate has no roll." % string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let 'tt := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Delegate has no roll." % string
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
                "Delegate has no roll." % string))) empty
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.No_roll_for_delegate
          => Some tt
        | _ => None
        end)
      (fun function_parameter =>
        let 'tt := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.No_roll_for_delegate)
    in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "contract.manager.no_roll_snapshot_for_cycle" % string
      "No roll snapshot for cycle" % string
      "A snapshot of the rolls distribution does not exist for this cycle." %
        string
      (Some
        (fun ppf =>
          fun c =>
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "A snapshot of the rolls distribution does not exist for cycle "
                    % string
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                    Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format))
                "A snapshot of the rolls distribution does not exist for cycle %a"
                  % string) Cycle_repr.pp c))
      (obj1 (req None None "cycle" % string Cycle_repr.encoding))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.No_roll_snapshot_for_cycle
            c => Some c
        | _ => None
        end)
      (fun c =>
        Tezos_protocol_environment_alpha__Environment.Error_monad.No_roll_snapshot_for_cycle
          c) in
  register_error_kind
    (* ❌ Variants not supported *)
    variant "contract.manager.unregistered_delegate" % string
    "Unregistered delegate" % string
    "A contract cannot be delegated to an unregistered delegate" % string
    (Some
      (fun ppf =>
        fun k =>
          Format.fprintf ppf
            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                "The provided public key (with hash " % string
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                    ") is  not registered as valid delegate key." % string
                    Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))
              "The provided public key (with hash %a) is  not registered as valid delegate key."
                % string) Signature.Public_key_hash.pp k))
    (obj1 (req None None "hash" % string Signature.Public_key_hash.encoding))
    (fun function_parameter =>
      match function_parameter with
      |
        Tezos_protocol_environment_alpha__Environment.Error_monad.Unregistered_delegate
          k => Some k
      | _ => None
      end)
    (fun k =>
      Tezos_protocol_environment_alpha__Environment.Error_monad.Unregistered_delegate
        k).

Definition get_contract_delegate
  (c : Tezos_raw_protocol_alpha.Storage.Contract.Delegate.context)
  (contract : Tezos_raw_protocol_alpha.Storage.Contract.Delegate.key)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (option Tezos_raw_protocol_alpha.Storage.Contract.Delegate.value)) :=
  Storage.Contract.Delegate.get_option c contract.

Definition delegate_pubkey
  (ctxt : Tezos_raw_protocol_alpha.Storage.Contract.Manager.context)
  (delegate :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t) :=
  op_gtgteqquestion
    (Storage.Contract.Manager.get_option ctxt
      (Contract_repr.implicit_contract delegate))
    (fun function_parameter =>
      match function_parameter with
      | None | Some (Tezos_raw_protocol_alpha.Manager_repr.Hash _) =>
        fail
          (Tezos_protocol_environment_alpha__Environment.Error_monad.Unregistered_delegate
            delegate)
      | Some (Tezos_raw_protocol_alpha.Manager_repr.Public_key pk) =>
        __return pk
      end).

Definition clear_cycle
  (c : Tezos_raw_protocol_alpha.Storage.Roll.Snapshot_for_cycle.context)
  (cycle : Tezos_raw_protocol_alpha.Storage.Roll.Snapshot_for_cycle.key)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  op_gtgteqquestion (Storage.Roll.Snapshot_for_cycle.get c cycle)
    (fun index =>
      op_gtgteqquestion (Storage.Roll.Snapshot_for_cycle.delete c cycle)
        (fun c =>
          op_gtgteqquestion
            (Storage.Roll.Last_for_snapshot.delete (c, cycle) index)
            (fun c =>
              op_gtgteq (Storage.Roll.Owner.delete_snapshot c (cycle, index))
                (fun c => __return c)))).

Definition fold {A : Set}
  (ctxt : Tezos_raw_protocol_alpha.Storage.Roll.Next.context)
  (f :
    Tezos_raw_protocol_alpha.Roll_repr.roll ->
    Tezos_raw_protocol_alpha.Storage.Roll.Owner.value -> A ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult A))
  (init : A)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult A) :=
  op_gtgteqquestion (Storage.Roll.Next.get ctxt)
    (fun last =>
      let fix loop
        (ctxt : Tezos_raw_protocol_alpha.Storage.Roll.Owner.context) (roll :
        Tezos_raw_protocol_alpha.Roll_repr.roll) (acc :
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult A))
        : Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult A) :=
        op_gtgteqquestion acc
          (fun acc =>
            if op_eq roll last then
              __return acc
            else
              op_gtgteqquestion (Storage.Roll.Owner.get_option ctxt roll)
                (fun function_parameter =>
                  match function_parameter with
                  | None => loop ctxt (Roll_repr.succ roll) (__return acc)
                  | Some delegate =>
                    loop ctxt (Roll_repr.succ roll) (f roll delegate acc)
                  end)) in
      loop ctxt Roll_repr.first (__return init)).

Definition snapshot_rolls_for_cycle
  (ctxt : Tezos_raw_protocol_alpha.Storage.Roll.Snapshot_for_cycle.context)
  (cycle : Tezos_raw_protocol_alpha.Storage.Roll.Snapshot_for_cycle.key)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  op_gtgteqquestion (Storage.Roll.Snapshot_for_cycle.get ctxt cycle)
    (fun index =>
      op_gtgteqquestion
        (Storage.Roll.Snapshot_for_cycle.set ctxt cycle (op_plus index 1))
        (fun ctxt =>
          op_gtgteqquestion (Storage.Roll.Owner.snapshot ctxt (cycle, index))
            (fun ctxt =>
              op_gtgteqquestion (Storage.Roll.Next.get ctxt)
                (fun last =>
                  op_gtgteqquestion
                    (Storage.Roll.Last_for_snapshot.init (ctxt, cycle) index
                      last) (fun ctxt => __return ctxt))))).

Definition freeze_rolls_for_cycle
  (ctxt : Tezos_raw_protocol_alpha.Storage.Roll.Snapshot_for_cycle.context)
  (cycle : Tezos_raw_protocol_alpha.Storage.Roll.Snapshot_for_cycle.key)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Storage.Roll.Owner.context) :=
  op_gtgteqquestion (Storage.Roll.Snapshot_for_cycle.get ctxt cycle)
    (fun max_index =>
      op_gtgteqquestion (Storage.Seed.For_cycle.get ctxt cycle)
        (fun seed =>
          let rd :=
            Seed_repr.initialize_new seed
              (cons (MBytes.of_string "roll_snapshot" % string) []) in
          let seq :=
            Seed_repr.sequence rd
              (* ❌ Constant of type int32 is converted to int *)
              0 in
          let selected_index :=
            op_pipegt
              (op_pipegt (Seed_repr.take_int32 seq (Int32.of_int max_index)) fst)
              Int32.to_int in
          op_gtgteqquestion
            (Storage.Roll.Snapshot_for_cycle.set ctxt cycle selected_index)
            (fun ctxt =>
              op_gtgteqquestion
                (fold_left_s
                  (fun ctxt =>
                    fun index =>
                      if op_eq index selected_index then
                        __return ctxt
                      else
                        op_gtgteq
                          (Storage.Roll.Owner.delete_snapshot ctxt
                            (cycle, index))
                          (fun ctxt =>
                            op_gtgteqquestion
                              (Storage.Roll.Last_for_snapshot.delete
                                (ctxt, cycle) index) (fun ctxt => __return ctxt)))
                  ctxt (op_minusminusgt 0 (op_minus max_index 1)))
                (fun ctxt => __return ctxt)))).

Module Random.
  Definition int32_to_bytes (i : int32)
    : Tezos_protocol_environment_alpha__Environment.MBytes.t :=
    let b := MBytes.create 4 in
    (* ❌ Sequences of instructions are not handled (operator ";") *)
    let _ := MBytes.set_int32 b 0 i in
    b.
  
  Definition level_random
    (seed : Tezos_raw_protocol_alpha.Seed_repr.seed) (use : string)
    (level : Tezos_raw_protocol_alpha.Level_repr.t)
    : Tezos_raw_protocol_alpha.Seed_repr.t :=
    let position := Tezos_raw_protocol_alpha.Level_repr.t.cycle_position level
      in
    Seed_repr.initialize_new seed
      (cons
        (MBytes.of_string
          (op_caret "level " % string (op_caret use ":" % string)))
        (cons (int32_to_bytes position) [])).
  
  Definition owner
    (c : Tezos_raw_protocol_alpha.Raw_context.t) (kind : string)
    (level : Tezos_raw_protocol_alpha.Level_repr.t) (offset : Z)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        Tezos_raw_protocol_alpha.Storage.Roll.Owner.Snapshot.value) :=
    let cycle := Tezos_raw_protocol_alpha.Level_repr.t.cycle level in
    op_gtgteqquestion (Seed_storage.for_cycle c cycle)
      (fun random_seed =>
        let rd := level_random random_seed kind level in
        let sequence := Seed_repr.sequence rd (Int32.of_int offset) in
        op_gtgteqquestion (Storage.Roll.Snapshot_for_cycle.get c cycle)
          (fun index =>
            op_gtgteqquestion
              (Storage.Roll.Last_for_snapshot.get (c, cycle) index)
              (fun bound =>
                let fix loop
                  (sequence : Tezos_raw_protocol_alpha.Seed_repr.sequence)
                  : Tezos_protocol_environment_alpha__Environment.Lwt.t
                    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
                      Tezos_raw_protocol_alpha.Storage.Roll.Owner.Snapshot.value) :=
                  let '(roll, sequence) := Roll_repr.random sequence bound in
                  op_gtgteqquestion
                    (Storage.Roll.Owner.Snapshot.get_option c
                      ((cycle, index), roll))
                    (fun function_parameter =>
                      match function_parameter with
                      | None => loop sequence
                      | Some delegate => __return delegate
                      end) in
                op_gtgteq (Storage.Roll.Owner.snapshot_exists c (cycle, index))
                  (fun snapshot_exists =>
                    op_gtgteqquestion
                      (fail_unless snapshot_exists
                        (Tezos_protocol_environment_alpha__Environment.Error_monad.No_roll_snapshot_for_cycle
                          cycle))
                      (fun function_parameter =>
                        let 'tt := function_parameter in
                        loop sequence))))).
End Random.

Definition baking_rights_owner
  (c : Tezos_raw_protocol_alpha.Raw_context.t)
  (level : Tezos_raw_protocol_alpha.Level_repr.t) (priority : Z)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Storage.Roll.Owner.Snapshot.value) :=
  Random.owner c "baking" % string level priority.

Definition endorsement_rights_owner
  (c : Tezos_raw_protocol_alpha.Raw_context.t)
  (level : Tezos_raw_protocol_alpha.Level_repr.t) (slot : Z)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Storage.Roll.Owner.Snapshot.value) :=
  Random.owner c "endorsement" % string level slot.

Definition traverse_rolls
  (ctxt : Tezos_raw_protocol_alpha.Storage.Roll.Successor.context)
  (head : Tezos_raw_protocol_alpha.Storage.Roll.Successor.value)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (list Tezos_raw_protocol_alpha.Storage.Roll.Successor.value)) :=
  let fix loop
    (acc : list Tezos_raw_protocol_alpha.Storage.Roll.Successor.value) (roll :
    Tezos_raw_protocol_alpha.Storage.Roll.Successor.key)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (list Tezos_raw_protocol_alpha.Storage.Roll.Successor.value)) :=
    op_gtgteqquestion (Storage.Roll.Successor.get_option ctxt roll)
      (fun function_parameter =>
        match function_parameter with
        | None => __return (List.rev acc)
        | Some next => loop (cons next acc) next
        end) in
  loop (cons head []) head.

Definition get_rolls
  (ctxt : Tezos_raw_protocol_alpha.Storage.Roll.Delegate_roll_list.context)
  (delegate : Tezos_raw_protocol_alpha.Storage.Roll.Delegate_roll_list.key)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (list Tezos_raw_protocol_alpha.Storage.Roll.Successor.value)) :=
  op_gtgteqquestion (Storage.Roll.Delegate_roll_list.get_option ctxt delegate)
    (fun function_parameter =>
      match function_parameter with
      | None => return_nil
      | Some head_roll => traverse_rolls ctxt head_roll
      end).

Definition count_rolls
  (ctxt : Tezos_raw_protocol_alpha.Storage.Roll.Delegate_roll_list.context)
  (delegate : Tezos_raw_protocol_alpha.Storage.Roll.Delegate_roll_list.key)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult Z) :=
  op_gtgteqquestion (Storage.Roll.Delegate_roll_list.get_option ctxt delegate)
    (fun function_parameter =>
      match function_parameter with
      | None => __return 0
      | Some head_roll =>
        let fix loop
          (acc : Z) (roll : Tezos_raw_protocol_alpha.Storage.Roll.Successor.key)
          : Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
              Z) :=
          op_gtgteqquestion (Storage.Roll.Successor.get_option ctxt roll)
            (fun function_parameter =>
              match function_parameter with
              | None => __return acc
              | Some next => loop (succ acc) next
              end) in
        loop 1 head_roll
      end).

Definition get_change
  (c : Tezos_raw_protocol_alpha.Storage.Roll.Delegate_change.context)
  (delegate : Tezos_raw_protocol_alpha.Storage.Roll.Delegate_change.key)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Tez_repr.t) :=
  op_gtgteqquestion (Storage.Roll.Delegate_change.get_option c delegate)
    (fun function_parameter =>
      match function_parameter with
      | None => __return Tez_repr.zero
      | Some change => __return change
      end).

Module Delegate.
  Definition fresh_roll (c : Tezos_raw_protocol_alpha.Storage.Roll.Next.context)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (Tezos_raw_protocol_alpha.Storage.Roll.Next.value *
          Tezos_raw_protocol_alpha.Raw_context.t)) :=
    op_gtgteqquestion (Storage.Roll.Next.get c)
      (fun roll =>
        op_gtgteqquestion (Storage.Roll.Next.set c (Roll_repr.succ roll))
          (fun c => __return (roll, c))).
  
  Definition get_limbo_roll
    (c : Tezos_raw_protocol_alpha.Storage.Roll.Limbo.context)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (Tezos_raw_protocol_alpha.Storage.Roll.Next.value *
          Tezos_raw_protocol_alpha.Raw_context.t)) :=
    op_gtgteqquestion (Storage.Roll.Limbo.get_option c)
      (fun function_parameter =>
        match function_parameter with
        | None =>
          op_gtgteqquestion (fresh_roll c)
            (fun function_parameter =>
              let '(roll, c) := function_parameter in
              op_gtgteqquestion (Storage.Roll.Limbo.init c roll)
                (fun c => __return (roll, c)))
        | Some roll => __return (roll, c)
        end).
  
  Definition consume_roll_change
    (c : Tezos_raw_protocol_alpha.Raw_context.context)
    (delegate : Tezos_raw_protocol_alpha.Storage.Roll.Delegate_change.key)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        Tezos_raw_protocol_alpha.Raw_context.t) :=
    let tokens_per_roll := Constants_storage.tokens_per_roll c in
    op_gtgteqquestion (Storage.Roll.Delegate_change.get c delegate)
      (fun change =>
        op_gtgteqquestion
          (trace
            Tezos_protocol_environment_alpha__Environment.Error_monad.Consume_roll_change
            (Lwt.__return (op_minusquestion change tokens_per_roll)))
          (fun new_change =>
            Storage.Roll.Delegate_change.set c delegate new_change)).
  
  Definition recover_roll_change
    (c : Tezos_raw_protocol_alpha.Raw_context.context)
    (delegate : Tezos_raw_protocol_alpha.Storage.Roll.Delegate_change.key)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        Tezos_raw_protocol_alpha.Raw_context.t) :=
    let tokens_per_roll := Constants_storage.tokens_per_roll c in
    op_gtgteqquestion (Storage.Roll.Delegate_change.get c delegate)
      (fun change =>
        op_gtgteqquestion
          (Lwt.__return (op_plusquestion change tokens_per_roll))
          (fun new_change =>
            Storage.Roll.Delegate_change.set c delegate new_change)).
  
  Definition pop_roll_from_delegate
    (c : Tezos_raw_protocol_alpha.Raw_context.context)
    (delegate : Tezos_raw_protocol_alpha.Storage.Roll.Delegate_change.key)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (Tezos_raw_protocol_alpha.Storage.Roll.Delegate_roll_list.value *
          Tezos_raw_protocol_alpha.Raw_context.t)) :=
    op_gtgteqquestion (recover_roll_change c delegate)
      (fun c =>
        op_gtgteqquestion (Storage.Roll.Limbo.get_option c)
          (fun limbo_head =>
            op_gtgteqquestion
              (Storage.Roll.Delegate_roll_list.get_option c delegate)
              (fun function_parameter =>
                match function_parameter with
                | None =>
                  fail
                    Tezos_protocol_environment_alpha__Environment.Error_monad.No_roll_for_delegate
                | Some roll =>
                  op_gtgteqquestion (Storage.Roll.Owner.delete c roll)
                    (fun c =>
                      op_gtgteqquestion
                        (Storage.Roll.Successor.get_option c roll)
                        (fun successor_roll =>
                          op_gtgteq
                            (Storage.Roll.Delegate_roll_list.set_option c
                              delegate successor_roll)
                            (fun c =>
                              op_gtgteq
                                (Storage.Roll.Successor.set_option c roll
                                  limbo_head)
                                (fun c =>
                                  op_gtgteq (Storage.Roll.Limbo.init_set c roll)
                                    (fun c => __return (roll, c))))))
                end))).
  
  Definition create_roll_in_delegate
    (c : Tezos_raw_protocol_alpha.Raw_context.context)
    (delegate : Tezos_raw_protocol_alpha.Storage.Roll.Delegate_change.key)
    (delegate_pk : Tezos_raw_protocol_alpha.Storage.Roll.Owner.value)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        Tezos_raw_protocol_alpha.Raw_context.t) :=
    op_gtgteqquestion (consume_roll_change c delegate)
      (fun c =>
        op_gtgteqquestion
          (Storage.Roll.Delegate_roll_list.get_option c delegate)
          (fun delegate_head =>
            op_gtgteqquestion (get_limbo_roll c)
              (fun function_parameter =>
                let '(roll, c) := function_parameter in
                op_gtgteqquestion (Storage.Roll.Owner.init c roll delegate_pk)
                  (fun c =>
                    op_gtgteqquestion (Storage.Roll.Successor.get_option c roll)
                      (fun limbo_successor =>
                        op_gtgteq
                          (Storage.Roll.Limbo.set_option c limbo_successor)
                          (fun c =>
                            op_gtgteq
                              (Storage.Roll.Successor.set_option c roll
                                delegate_head)
                              (fun c =>
                                op_gtgteq
                                  (Storage.Roll.Delegate_roll_list.init_set c
                                    delegate roll) (fun c => __return c)))))))).
  
  Definition ensure_inited
    (c : Tezos_raw_protocol_alpha.Storage.Roll.Delegate_change.context)
    (delegate : Tezos_raw_protocol_alpha.Storage.Roll.Delegate_change.key)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        Tezos_raw_protocol_alpha.Storage.Roll.Delegate_change.context) :=
    op_gtgteq (Storage.Roll.Delegate_change.mem c delegate)
      (fun function_parameter =>
        match function_parameter with
        | true => __return c
        | false => Storage.Roll.Delegate_change.init c delegate Tez_repr.zero
        end).
  
  Definition is_inactive
    (c : Tezos_raw_protocol_alpha.Storage.Contract.Inactive_delegate.context)
    (delegate :
      Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult bool) :=
    op_gtgteq
      (Storage.Contract.Inactive_delegate.mem c
        (Contract_repr.implicit_contract delegate))
      (fun inactive =>
        if inactive then
          __return inactive
        else
          op_gtgteqquestion
            (Storage.Contract.Delegate_desactivation.get_option c
              (Contract_repr.implicit_contract delegate))
            (fun function_parameter =>
              match function_parameter with
              | Some last_active_cycle =>
                let '{|
                  Tezos_raw_protocol_alpha.Level_repr.t.cycle := current_cycle
                    |} := Raw_context.current_level c in
                __return (op_lt last_active_cycle current_cycle)
              | None => return_false
              end)).
  
  Definition add_amount
    (c : Tezos_raw_protocol_alpha.Storage.Roll.Delegate_change.context)
    (delegate : Tezos_raw_protocol_alpha.Storage.Roll.Delegate_change.key)
    (amount : Tezos_raw_protocol_alpha.Tez_repr.t)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        Tezos_raw_protocol_alpha.Raw_context.t) :=
    op_gtgteqquestion (ensure_inited c delegate)
      (fun c =>
        let tokens_per_roll := Constants_storage.tokens_per_roll c in
        op_gtgteqquestion (Storage.Roll.Delegate_change.get c delegate)
          (fun change =>
            op_gtgteqquestion (Lwt.__return (op_plusquestion amount change))
              (fun change =>
                op_gtgteqquestion
                  (Storage.Roll.Delegate_change.set c delegate change)
                  (fun c =>
                    op_gtgteqquestion (delegate_pubkey c delegate)
                      (fun delegate_pk =>
                        let fix loop
                          (c : Tezos_raw_protocol_alpha.Raw_context.context)
                          (change : Tezos_raw_protocol_alpha.Tez_repr.t)
                          : Tezos_protocol_environment_alpha__Environment.Lwt.t
                            (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
                              Tezos_raw_protocol_alpha.Raw_context.context) :=
                          if op_lt change tokens_per_roll then
                            __return c
                          else
                            op_gtgteqquestion
                              (Lwt.__return
                                (op_minusquestion change tokens_per_roll))
                              (fun change =>
                                op_gtgteqquestion
                                  (create_roll_in_delegate c delegate
                                    delegate_pk) (fun c => loop c change)) in
                        op_gtgteqquestion (is_inactive c delegate)
                          (fun inactive =>
                            if inactive then
                              __return c
                            else
                              op_gtgteqquestion (loop c change)
                                (fun c =>
                                  op_gtgteqquestion
                                    (Storage.Roll.Delegate_roll_list.get_option
                                      c delegate)
                                    (fun rolls =>
                                      match rolls with
                                      | None => __return c
                                      | Some _ =>
                                        op_gtgteq
                                          (Storage.Active_delegates_with_rolls.add
                                            c delegate) (fun c => __return c)
                                      end)))))))).
  
  Definition remove_amount
    (c : Tezos_raw_protocol_alpha.Raw_context.context)
    (delegate : Tezos_raw_protocol_alpha.Storage.Roll.Delegate_change.key)
    (amount : Tezos_raw_protocol_alpha.Tez_repr.t)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        Tezos_raw_protocol_alpha.Raw_context.t) :=
    let tokens_per_roll := Constants_storage.tokens_per_roll c in
    let fix loop
      (c : Tezos_raw_protocol_alpha.Raw_context.context) (change :
      Tezos_raw_protocol_alpha.Tez_repr.t)
      : Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_raw_protocol_alpha.Raw_context.context *
            Tezos_raw_protocol_alpha.Tez_repr.t)) :=
      if op_lteq amount change then
        __return (c, change)
      else
        op_gtgteqquestion (pop_roll_from_delegate c delegate)
          (fun function_parameter =>
            let '(_, c) := function_parameter in
            op_gtgteqquestion
              (Lwt.__return (op_plusquestion change tokens_per_roll))
              (fun change => loop c change)) in
    op_gtgteqquestion (Storage.Roll.Delegate_change.get c delegate)
      (fun change =>
        op_gtgteqquestion (is_inactive c delegate)
          (fun inactive =>
            op_gtgteqquestion
              (if inactive then
                __return (c, change)
              else
                op_gtgteqquestion (loop c change)
                  (fun function_parameter =>
                    let '(c, change) := function_parameter in
                    op_gtgteqquestion
                      (Storage.Roll.Delegate_roll_list.get_option c delegate)
                      (fun rolls =>
                        match rolls with
                        | None =>
                          op_gtgteq
                            (Storage.Active_delegates_with_rolls.del c delegate)
                            (fun c => __return (c, change))
                        | Some _ => __return (c, change)
                        end)))
              (fun function_parameter =>
                let '(c, change) := function_parameter in
                op_gtgteqquestion
                  (Lwt.__return (op_minusquestion change amount))
                  (fun change =>
                    Storage.Roll.Delegate_change.set c delegate change)))).
  
  Definition set_inactive
    (ctxt : Tezos_raw_protocol_alpha.Storage.Roll.Delegate_change.context)
    (delegate : Tezos_raw_protocol_alpha.Storage.Roll.Delegate_change.key)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        Tezos_raw_protocol_alpha.Raw_context.t) :=
    op_gtgteqquestion (ensure_inited ctxt delegate)
      (fun ctxt =>
        let tokens_per_roll := Constants_storage.tokens_per_roll ctxt in
        op_gtgteqquestion (Storage.Roll.Delegate_change.get ctxt delegate)
          (fun change =>
            op_gtgteq
              (Storage.Contract.Inactive_delegate.add ctxt
                (Contract_repr.implicit_contract delegate))
              (fun ctxt =>
                op_gtgteq
                  (Storage.Active_delegates_with_rolls.del ctxt delegate)
                  (fun ctxt =>
                    let fix loop
                      (ctxt :
                      Tezos_raw_protocol_alpha.Storage.Roll.Delegate_roll_list.context)
                      (change : Tezos_raw_protocol_alpha.Tez_repr.t)
                      : Tezos_protocol_environment_alpha__Environment.Lwt.t
                        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
                          (Tezos_raw_protocol_alpha.Storage.Roll.Delegate_roll_list.context
                            * Tezos_raw_protocol_alpha.Tez_repr.t)) :=
                      op_gtgteqquestion
                        (Storage.Roll.Delegate_roll_list.get_option ctxt
                          delegate)
                        (fun function_parameter =>
                          match function_parameter with
                          | None => __return (ctxt, change)
                          | Some _roll =>
                            op_gtgteqquestion
                              (pop_roll_from_delegate ctxt delegate)
                              (fun function_parameter =>
                                let '(_, ctxt) := function_parameter in
                                op_gtgteqquestion
                                  (Lwt.__return
                                    (op_plusquestion change tokens_per_roll))
                                  (fun change => loop ctxt change))
                          end) in
                    op_gtgteqquestion (loop ctxt change)
                      (fun function_parameter =>
                        let '(ctxt, change) := function_parameter in
                        op_gtgteqquestion
                          (Storage.Roll.Delegate_change.set ctxt delegate change)
                          (fun ctxt => __return ctxt)))))).
  
  Definition set_active
    (ctxt : Tezos_raw_protocol_alpha.Storage.Contract.Inactive_delegate.context)
    (delegate :
      Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        Tezos_raw_protocol_alpha.Raw_context.t) :=
    op_gtgteqquestion (is_inactive ctxt delegate)
      (fun inactive =>
        let current_cycle :=
          Tezos_raw_protocol_alpha.Level_repr.t.cycle
            (Raw_context.current_level ctxt) in
        let preserved_cycles := Constants_storage.preserved_cycles ctxt in
        op_gtgteqquestion
          (Storage.Contract.Delegate_desactivation.get_option ctxt
            (Contract_repr.implicit_contract delegate))
          (fun current_expiration =>
            let expiration :=
              match current_expiration with
              | None =>
                Cycle_repr.add current_cycle
                  (op_plus 1 (op_star 2 preserved_cycles))
              | Some current_expiration =>
                let delay :=
                  if inactive then
                    op_plus 1 (op_star 2 preserved_cycles)
                  else
                    op_plus 1 preserved_cycles in
                let updated := Cycle_repr.add current_cycle delay in
                Cycle_repr.max current_expiration updated
              end in
            op_gtgteq
              (Storage.Contract.Delegate_desactivation.init_set ctxt
                (Contract_repr.implicit_contract delegate) expiration)
              (fun ctxt =>
                if not inactive then
                  __return ctxt
                else
                  op_gtgteqquestion (ensure_inited ctxt delegate)
                    (fun ctxt =>
                      let tokens_per_roll :=
                        Constants_storage.tokens_per_roll ctxt in
                      op_gtgteqquestion
                        (Storage.Roll.Delegate_change.get ctxt delegate)
                        (fun change =>
                          op_gtgteq
                            (Storage.Contract.Inactive_delegate.del ctxt
                              (Contract_repr.implicit_contract delegate))
                            (fun ctxt =>
                              op_gtgteqquestion (delegate_pubkey ctxt delegate)
                                (fun delegate_pk =>
                                  let fix loop
                                    (ctxt :
                                    Tezos_raw_protocol_alpha.Raw_context.context)
                                    (change :
                                    Tezos_raw_protocol_alpha.Tez_repr.t)
                                    : Tezos_protocol_environment_alpha__Environment.Lwt.t
                                      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
                                        Tezos_raw_protocol_alpha.Raw_context.context) :=
                                    if op_lt change tokens_per_roll then
                                      __return ctxt
                                    else
                                      op_gtgteqquestion
                                        (Lwt.__return
                                          (op_minusquestion change
                                            tokens_per_roll))
                                        (fun change =>
                                          op_gtgteqquestion
                                            (create_roll_in_delegate ctxt
                                              delegate delegate_pk)
                                            (fun ctxt => loop ctxt change)) in
                                  op_gtgteqquestion (loop ctxt change)
                                    (fun ctxt =>
                                      op_gtgteqquestion
                                        (Storage.Roll.Delegate_roll_list.get_option
                                          ctxt delegate)
                                        (fun rolls =>
                                          match rolls with
                                          | None => __return ctxt
                                          | Some _ =>
                                            op_gtgteq
                                              (Storage.Active_delegates_with_rolls.add
                                                ctxt delegate)
                                              (fun ctxt => __return ctxt)
                                          end))))))))).
End Delegate.

Module Contract.
  Definition add_amount
    (c : Tezos_raw_protocol_alpha.Storage.Contract.Delegate.context)
    (contract : Tezos_raw_protocol_alpha.Storage.Contract.Delegate.key)
    (amount : Tezos_raw_protocol_alpha.Tez_repr.t)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        Tezos_raw_protocol_alpha.Storage.Contract.Delegate.context) :=
    op_gtgteqquestion (get_contract_delegate c contract)
      (fun function_parameter =>
        match function_parameter with
        | None => __return c
        | Some delegate => Delegate.add_amount c delegate amount
        end).
  
  Definition remove_amount
    (c : Tezos_raw_protocol_alpha.Storage.Contract.Delegate.context)
    (contract : Tezos_raw_protocol_alpha.Storage.Contract.Delegate.key)
    (amount : Tezos_raw_protocol_alpha.Tez_repr.t)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        Tezos_raw_protocol_alpha.Storage.Contract.Delegate.context) :=
    op_gtgteqquestion (get_contract_delegate c contract)
      (fun function_parameter =>
        match function_parameter with
        | None => __return c
        | Some delegate => Delegate.remove_amount c delegate amount
        end).
End Contract.

Definition init (ctxt : Tezos_raw_protocol_alpha.Storage.Roll.Next.context)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  Storage.Roll.Next.init ctxt Roll_repr.first.

Definition init_first_cycles
  (ctxt : Tezos_raw_protocol_alpha.Raw_context.context)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  let preserved := Constants_storage.preserved_cycles ctxt in
  op_gtgteqquestion
    (List.fold_left
      (fun ctxt =>
        fun c =>
          op_gtgteqquestion ctxt
            (fun ctxt =>
              let cycle := Cycle_repr.of_int32_exn (Int32.of_int c) in
              op_gtgteqquestion
                (Storage.Roll.Snapshot_for_cycle.init ctxt cycle 0)
                (fun ctxt =>
                  op_gtgteqquestion (snapshot_rolls_for_cycle ctxt cycle)
                    (fun ctxt => freeze_rolls_for_cycle ctxt cycle))))
      (__return ctxt) (op_minusminusgt 0 preserved))
    (fun ctxt =>
      let cycle := Cycle_repr.of_int32_exn (Int32.of_int (op_plus preserved 1))
        in
      op_gtgteqquestion (Storage.Roll.Snapshot_for_cycle.init ctxt cycle 0)
        (fun ctxt =>
          op_gtgteqquestion (snapshot_rolls_for_cycle ctxt cycle)
            (fun ctxt =>
              let cycle :=
                Cycle_repr.of_int32_exn (Int32.of_int (op_plus preserved 2)) in
              op_gtgteqquestion
                (Storage.Roll.Snapshot_for_cycle.init ctxt cycle 0)
                (fun ctxt => __return ctxt)))).

Definition snapshot_rolls (ctxt : Tezos_raw_protocol_alpha.Raw_context.context)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  let current_level := Raw_context.current_level ctxt in
  let preserved := Constants_storage.preserved_cycles ctxt in
  let cycle :=
    Cycle_repr.add (Tezos_raw_protocol_alpha.Level_repr.t.cycle current_level)
      (op_plus preserved 2) in
  snapshot_rolls_for_cycle ctxt cycle.

Definition cycle_end
  (ctxt : Tezos_raw_protocol_alpha.Raw_context.context)
  (last_cycle : Tezos_raw_protocol_alpha.Cycle_repr.cycle)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  let preserved := Constants_storage.preserved_cycles ctxt in
  op_gtgteqquestion
    match Cycle_repr.sub last_cycle preserved with
    | None => __return ctxt
    | Some cleared_cycle => clear_cycle ctxt cleared_cycle
    end
    (fun ctxt =>
      let frozen_roll_cycle := Cycle_repr.add last_cycle (op_plus preserved 1)
        in
      op_gtgteqquestion (freeze_rolls_for_cycle ctxt frozen_roll_cycle)
        (fun ctxt =>
          op_gtgteqquestion
            (Storage.Roll.Snapshot_for_cycle.init ctxt
              (Cycle_repr.succ (Cycle_repr.succ frozen_roll_cycle)) 0)
            (fun ctxt => __return ctxt))).

Definition update_tokens_per_roll
  (ctxt : Tezos_raw_protocol_alpha.Raw_context.context)
  (new_tokens_per_roll : Tezos_raw_protocol_alpha.Tez_repr.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.context) :=
  let constants := Raw_context.constants ctxt in
  let old_tokens_per_roll :=
    Tezos_raw_protocol_alpha.Constants_repr.parametric.tokens_per_roll constants
    in
  op_gtgteq
    (Raw_context.patch_constants ctxt
      (fun constants =>
        (* ❌ Record substitution not handled *)
        record_substitution))
    (fun ctxt =>
      let decrease := op_lt new_tokens_per_roll old_tokens_per_roll in
      op_gtgteqquestion
        (if decrease then
          Lwt.__return
            (op_minusquestion old_tokens_per_roll new_tokens_per_roll)
        else
          Lwt.__return
            (op_minusquestion new_tokens_per_roll old_tokens_per_roll))
        (fun abs_diff =>
          Storage.Delegates.fold ctxt
            (Tezos_protocol_environment_alpha__Environment.Pervasives.Ok ctxt)
            (fun pkh =>
              fun ctxt =>
                op_gtgteqquestion (Lwt.__return ctxt)
                  (fun ctxt =>
                    op_gtgteqquestion (count_rolls ctxt pkh)
                      (fun rolls =>
                        op_gtgteqquestion
                          (Lwt.__return
                            (op_starquestion abs_diff (Int64.of_int rolls)))
                          (fun amount =>
                            if decrease then
                              Delegate.add_amount ctxt pkh amount
                            else
                              Delegate.remove_amount ctxt pkh amount)))))).

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

(**

   Basic roll manipulation.

   If storage related to roll (a.k.a. `Storage.Roll`) are not used
   outside of this module, this interface enforces the invariant that a
   roll is always either in the limbo list or in a contract list.

*)

type error +=
  | Consume_roll_change
  | No_roll_for_delegate
  | No_roll_snapshot_for_cycle of Cycle_repr.t
  | Unregistered_delegate of Signature.Public_key_hash.t

(* `Permanent *)

val init : Raw_context.t -> Raw_context.t tzresult Lwt.t

val init_first_cycles : Raw_context.t -> Raw_context.t tzresult Lwt.t

val cycle_end : Raw_context.t -> Cycle_repr.t -> Raw_context.t tzresult Lwt.t

val snapshot_rolls : Raw_context.t -> Raw_context.t tzresult Lwt.t

val fold :
  Raw_context.t ->
  f:(Roll_repr.roll -> Signature.Public_key.t -> 'a -> 'a tzresult Lwt.t) ->
  'a ->
  'a tzresult Lwt.t

val baking_rights_owner :
  Raw_context.t ->
  Level_repr.t ->
  priority:int ->
  Signature.Public_key.t tzresult Lwt.t

val endorsement_rights_owner :
  Raw_context.t ->
  Level_repr.t ->
  slot:int ->
  Signature.Public_key.t tzresult Lwt.t

module Delegate : sig
  val is_inactive :
    Raw_context.t -> Signature.Public_key_hash.t -> bool tzresult Lwt.t

  val add_amount :
    Raw_context.t ->
    Signature.Public_key_hash.t ->
    Tez_repr.t ->
    Raw_context.t tzresult Lwt.t

  val remove_amount :
    Raw_context.t ->
    Signature.Public_key_hash.t ->
    Tez_repr.t ->
    Raw_context.t tzresult Lwt.t

  val set_inactive :
    Raw_context.t ->
    Signature.Public_key_hash.t ->
    Raw_context.t tzresult Lwt.t

  val set_active :
    Raw_context.t ->
    Signature.Public_key_hash.t ->
    Raw_context.t tzresult Lwt.t
end

module Contract : sig
  val add_amount :
    Raw_context.t ->
    Contract_repr.t ->
    Tez_repr.t ->
    Raw_context.t tzresult Lwt.t

  val remove_amount :
    Raw_context.t ->
    Contract_repr.t ->
    Tez_repr.t ->
    Raw_context.t tzresult Lwt.t
end

val delegate_pubkey :
  Raw_context.t ->
  Signature.Public_key_hash.t ->
  Signature.Public_key.t tzresult Lwt.t

val get_rolls :
  Raw_context.t ->
  Signature.Public_key_hash.t ->
  Roll_repr.t list tzresult Lwt.t

val get_change :
  Raw_context.t -> Signature.Public_key_hash.t -> Tez_repr.t tzresult Lwt.t

val update_tokens_per_roll :
  Raw_context.t -> Tez_repr.t -> Raw_context.t tzresult Lwt.t

(**/**)

val get_contract_delegate :
  Raw_context.t ->
  Contract_repr.t ->
  Signature.Public_key_hash.t option tzresult Lwt.t

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

(* extensible_type Tezos_protocol_environment_alpha__Environment.Error_monad.error *)

Parameter init :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t).

Parameter init_first_cycles :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t).

Parameter cycle_end :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Cycle_repr.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t).

Parameter snapshot_rolls :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t).

Parameter fold : forall {a : Set},
  Tezos_raw_protocol_alpha.Raw_context.t ->
  (Tezos_raw_protocol_alpha.Roll_repr.roll ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t -> a ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult a)) ->
  a ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult a).

Parameter baking_rights_owner :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Level_repr.t -> Z ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t).

Parameter endorsement_rights_owner :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Level_repr.t -> Z ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t).

Module Delegate.
  Parameter is_inactive :
    Tezos_raw_protocol_alpha.Raw_context.t ->
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult bool).
  
  Parameter add_amount :
    Tezos_raw_protocol_alpha.Raw_context.t ->
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
    Tezos_raw_protocol_alpha.Tez_repr.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        Tezos_raw_protocol_alpha.Raw_context.t).
  
  Parameter remove_amount :
    Tezos_raw_protocol_alpha.Raw_context.t ->
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
    Tezos_raw_protocol_alpha.Tez_repr.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        Tezos_raw_protocol_alpha.Raw_context.t).
  
  Parameter set_inactive :
    Tezos_raw_protocol_alpha.Raw_context.t ->
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        Tezos_raw_protocol_alpha.Raw_context.t).
  
  Parameter set_active :
    Tezos_raw_protocol_alpha.Raw_context.t ->
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        Tezos_raw_protocol_alpha.Raw_context.t).
End Delegate.

Module Contract.
  Parameter add_amount :
    Tezos_raw_protocol_alpha.Raw_context.t ->
    Tezos_raw_protocol_alpha.Contract_repr.t ->
    Tezos_raw_protocol_alpha.Tez_repr.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        Tezos_raw_protocol_alpha.Raw_context.t).
  
  Parameter remove_amount :
    Tezos_raw_protocol_alpha.Raw_context.t ->
    Tezos_raw_protocol_alpha.Contract_repr.t ->
    Tezos_raw_protocol_alpha.Tez_repr.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        Tezos_raw_protocol_alpha.Raw_context.t).
End Contract.

Parameter delegate_pubkey :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t).

Parameter get_rolls :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (list Tezos_raw_protocol_alpha.Roll_repr.t)).

Parameter get_change :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Tez_repr.t).

Parameter update_tokens_per_roll :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Tez_repr.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t).

Parameter get_contract_delegate :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Contract_repr.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (option
        Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)).

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

let script_expr_hash = "\013\044\064\027" (* expr(54) *)

include Blake2B.Make
          (Base58)
          (struct
            let name = "script_expr"

            let title = "A script expression ID"

            let b58check_prefix = script_expr_hash

            let size = None
          end)

let () = Base58.check_encoded_prefix b58check_encoding "expr" 54

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Definition script_expr_hash : string := "
,@" % string.

(* ❌ Cannot include this kind of module expression *)
include

(* ❌ Top-level evaluations are considered as an error as sources of side-effects *)
Compute Base58.check_encoded_prefix b58check_encoding "expr" % string 54.

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

type n = Natural_tag

type z = Integer_tag

type 't num = Z.t

let compare x y = Z.compare x y

let zero = Z.zero

let zero_n = Z.zero

let to_string x = Z.to_string x

let of_string s = try Some (Z.of_string s) with _ -> None

let to_int64 x = try Some (Z.to_int64 x) with _ -> None

let of_int64 n = Z.of_int64 n

let to_int x = try Some (Z.to_int x) with _ -> None

let of_int n = Z.of_int n

let of_zint x = x

let to_zint x = x

let add x y = Z.add x y

let sub x y = Z.sub x y

let mul x y = Z.mul x y

let ediv x y =
  try
    let (q, r) = Z.ediv_rem x y in
    Some (q, r)
  with _ -> None

let add_n = add

let mul_n = mul

let ediv_n = ediv

let abs x = Z.abs x

let is_nat x = if Compare.Z.(x < Z.zero) then None else Some x

let neg x = Z.neg x

let int x = x

let shift_left x y =
  if Compare.Int.(Z.compare y (Z.of_int 256) > 0) then None
  else
    let y = Z.to_int y in
    Some (Z.shift_left x y)

let shift_right x y =
  if Compare.Int.(Z.compare y (Z.of_int 256) > 0) then None
  else
    let y = Z.to_int y in
    Some (Z.shift_right x y)

let shift_left_n = shift_left

let shift_right_n = shift_right

let logor x y = Z.logor x y

let logxor x y = Z.logxor x y

let logand x y = Z.logand x y

let lognot x = Z.lognot x

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Inductive n : Set :=
| Natural_tag : n.

Inductive z : Set :=
| Integer_tag : z.

Definition num (t : Set) := Tezos_protocol_environment_alpha__Environment.Z.t.

Definition compare
  (x : Tezos_protocol_environment_alpha__Environment.Z.t)
  (y : Tezos_protocol_environment_alpha__Environment.Z.t) : Z := Z.compare x y.

Definition zero : Tezos_protocol_environment_alpha__Environment.Z.t := Z.zero.

Definition zero_n : Tezos_protocol_environment_alpha__Environment.Z.t := Z.zero.

Definition to_string (x : Tezos_protocol_environment_alpha__Environment.Z.t)
  : string := Z.to_string x.

Definition of_string (s : string)
  : option Tezos_protocol_environment_alpha__Environment.Z.t :=
  (* ❌ Try-with are not handled *)
  try (Some (Z.of_string s)).

Definition to_int64 (x : Tezos_protocol_environment_alpha__Environment.Z.t)
  : option int64 :=
  (* ❌ Try-with are not handled *)
  try (Some (Z.to_int64 x)).

Definition of_int64 (n : int64)
  : Tezos_protocol_environment_alpha__Environment.Z.t := Z.of_int64 n.

Definition to_int (x : Tezos_protocol_environment_alpha__Environment.Z.t)
  : option Z :=
  (* ❌ Try-with are not handled *)
  try (Some (Z.to_int x)).

Definition of_int (n : Z) : Tezos_protocol_environment_alpha__Environment.Z.t :=
  Z.of_int n.

Definition of_zint {A : Set} (x : A) : A := x.

Definition to_zint {A : Set} (x : A) : A := x.

Definition add
  (x : Tezos_protocol_environment_alpha__Environment.Z.t)
  (y : Tezos_protocol_environment_alpha__Environment.Z.t)
  : Tezos_protocol_environment_alpha__Environment.Z.t := Z.add x y.

Definition sub
  (x : Tezos_protocol_environment_alpha__Environment.Z.t)
  (y : Tezos_protocol_environment_alpha__Environment.Z.t)
  : Tezos_protocol_environment_alpha__Environment.Z.t := Z.sub x y.

Definition mul
  (x : Tezos_protocol_environment_alpha__Environment.Z.t)
  (y : Tezos_protocol_environment_alpha__Environment.Z.t)
  : Tezos_protocol_environment_alpha__Environment.Z.t := Z.mul x y.

Definition ediv
  (x : Tezos_protocol_environment_alpha__Environment.Z.t)
  (y : Tezos_protocol_environment_alpha__Environment.Z.t)
  : option
    (Tezos_protocol_environment_alpha__Environment.Z.t *
      Tezos_protocol_environment_alpha__Environment.Z.t) :=
  (* ❌ Try-with are not handled *)
  try
    (let '(q, r) := Z.ediv_rem x y in
    Some (q, r)).

Definition add_n
  : Tezos_protocol_environment_alpha__Environment.Z.t ->
  Tezos_protocol_environment_alpha__Environment.Z.t ->
  Tezos_protocol_environment_alpha__Environment.Z.t := add.

Definition mul_n
  : Tezos_protocol_environment_alpha__Environment.Z.t ->
  Tezos_protocol_environment_alpha__Environment.Z.t ->
  Tezos_protocol_environment_alpha__Environment.Z.t := mul.

Definition ediv_n
  : Tezos_protocol_environment_alpha__Environment.Z.t ->
  Tezos_protocol_environment_alpha__Environment.Z.t ->
  option
    (Tezos_protocol_environment_alpha__Environment.Z.t *
      Tezos_protocol_environment_alpha__Environment.Z.t) := ediv.

Definition abs (x : Tezos_protocol_environment_alpha__Environment.Z.t)
  : Tezos_protocol_environment_alpha__Environment.Z.t := Z.abs x.

Definition is_nat
  (x : Tezos_protocol_environment_alpha__Environment.Compare.Z.t)
  : option Tezos_protocol_environment_alpha__Environment.Compare.Z.t :=
  if op_lt x Z.zero then
    None
  else
    Some x.

Definition neg (x : Tezos_protocol_environment_alpha__Environment.Z.t)
  : Tezos_protocol_environment_alpha__Environment.Z.t := Z.neg x.

Definition int {A : Set} (x : A) : A := x.

Definition shift_left
  (x : Tezos_protocol_environment_alpha__Environment.Z.t)
  (y : Tezos_protocol_environment_alpha__Environment.Z.t)
  : option Tezos_protocol_environment_alpha__Environment.Z.t :=
  if op_gt (Z.compare y (Z.of_int 256)) 0 then
    None
  else
    let y := Z.to_int y in
    Some (Z.shift_left x y).

Definition shift_right
  (x : Tezos_protocol_environment_alpha__Environment.Z.t)
  (y : Tezos_protocol_environment_alpha__Environment.Z.t)
  : option Tezos_protocol_environment_alpha__Environment.Z.t :=
  if op_gt (Z.compare y (Z.of_int 256)) 0 then
    None
  else
    let y := Z.to_int y in
    Some (Z.shift_right x y).

Definition shift_left_n
  : Tezos_protocol_environment_alpha__Environment.Z.t ->
  Tezos_protocol_environment_alpha__Environment.Z.t ->
  option Tezos_protocol_environment_alpha__Environment.Z.t := shift_left.

Definition shift_right_n
  : Tezos_protocol_environment_alpha__Environment.Z.t ->
  Tezos_protocol_environment_alpha__Environment.Z.t ->
  option Tezos_protocol_environment_alpha__Environment.Z.t := shift_right.

Definition logor
  (x : Tezos_protocol_environment_alpha__Environment.Z.t)
  (y : Tezos_protocol_environment_alpha__Environment.Z.t)
  : Tezos_protocol_environment_alpha__Environment.Z.t := Z.logor x y.

Definition logxor
  (x : Tezos_protocol_environment_alpha__Environment.Z.t)
  (y : Tezos_protocol_environment_alpha__Environment.Z.t)
  : Tezos_protocol_environment_alpha__Environment.Z.t := Z.logxor x y.

Definition logand
  (x : Tezos_protocol_environment_alpha__Environment.Z.t)
  (y : Tezos_protocol_environment_alpha__Environment.Z.t)
  : Tezos_protocol_environment_alpha__Environment.Z.t := Z.logand x y.

Definition lognot (x : Tezos_protocol_environment_alpha__Environment.Z.t)
  : Tezos_protocol_environment_alpha__Environment.Z.t := Z.lognot x.

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

(** The types for arbitraty precision integers in Michelson.
    The type variable ['t] is always [n] or [z],
    [n num] and [z num] are incompatible.

    This is internally a [Z.t].
    This module mostly adds signedness preservation guarantees. *)
type 't num

(** Flag for natural numbers. *)
and n = Natural_tag

(** Flag for relative numbers. *)
and z = Integer_tag

(** Natural zero. *)
val zero_n : n num

(** Relative zero. *)
val zero : z num

(** Compare two numbers as if they were *)
val compare : 'a num -> 'a num -> int

(** Conversion to an OCaml [string] in decimal notation. *)
val to_string : _ num -> string

(** Conversion from an OCaml [string].
    Returns [None] in case of an invalid notation.
    Supports [+] and [-] sign modifiers, and [0x], [0o] and [0b] base modifiers. *)
val of_string : string -> z num option

(** Conversion to an OCaml [int64], returns [None] on overflow. *)
val to_int64 : _ num -> int64 option

(** Conversion from an OCaml [int]. *)
val of_int64 : int64 -> z num

(** Conversion to an OCaml [int], returns [None] on overflow. *)
val to_int : _ num -> int option

(** Conversion from an OCaml [int64]. *)
val of_int : int -> z num

(** Conversion from a Zarith integer ([Z.t]). *)
val of_zint : Z.t -> z num

(** Conversion to a Zarith integer ([Z.t]). *)
val to_zint : 'a num -> Z.t

(** Addition between naturals. *)
val add_n : n num -> n num -> n num

(** Multiplication between naturals. *)
val mul_n : n num -> n num -> n num

(** Euclidean division between naturals.
    [ediv_n n d] returns [None] if divisor is zero,
    or [Some (q, r)] where [n = d * q + r] and [[0 <= r < d]] otherwise. *)
val ediv_n : n num -> n num -> (n num * n num) option

(** Sign agnostic addition.
    Use {!add_n} when working with naturals to preserve the sign. *)
val add : _ num -> _ num -> z num

(** Sign agnostic subtraction.
    Use {!sub_n} when working with naturals to preserve the sign. *)
val sub : _ num -> _ num -> z num

(** Sign agnostic multiplication.
    Use {!mul_n} when working with naturals to preserve the sign. *)
val mul : _ num -> _ num -> z num

(** Sign agnostic euclidean division.
    [ediv n d] returns [None] if divisor is zero,
    or [Some (q, r)] where [n = d * q + r] and [[0 <= r < |d|]] otherwise.
    Use {!ediv_n} when working with naturals to preserve the sign. *)
val ediv : _ num -> _ num -> (z num * n num) option

(** Compute the absolute value of a relative, turning it into a natural. *)
val abs : z num -> n num

(** Partial identity over [N]. *)
val is_nat : z num -> n num option

(** Negates a number. *)
val neg : _ num -> z num

(** Turns a natural into a relative, not changing its value. *)
val int : n num -> z num

(** Reverses each bit in the representation of the number.
    Also applies to the sign. *)
val lognot : _ num -> z num

(** Shifts the natural to the left of a number of bits between 0 and 256.
    Returns [None] if the amount is too high. *)
val shift_left_n : n num -> n num -> n num option

(** Shifts the natural to the right of a number of bits between 0 and 256.
    Returns [None] if the amount is too high. *)
val shift_right_n : n num -> n num -> n num option

(** Shifts the number to the left of a number of bits between 0 and 256.
    Returns [None] if the amount is too high. *)
val shift_left : 'a num -> n num -> 'a num option

(** Shifts the number to the right of a number of bits between 0 and 256.
    Returns [None] if the amount is too high. *)
val shift_right : 'a num -> n num -> 'a num option

(** Applies a boolean or operation to each bit. *)
val logor : 'a num -> 'a num -> 'a num

(** Applies a boolean and operation to each bit. *)
val logand : _ num -> n num -> n num

(** Applies a boolean xor operation to each bit. *)
val logxor : n num -> n num -> n num

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Inductive n : Set :=
| Natural_tag : n

with z : Set :=
| Integer_tag : z.

Parameter zero_n : num n.

Parameter zero : num z.

Parameter compare : forall {a : Set}, num a -> num a -> Z.

Parameter to_string : forall {A : Set}, num A -> string.

Parameter of_string : string -> option (num z).

Parameter to_int64 : forall {A : Set}, num A -> option int64.

Parameter of_int64 : int64 -> num z.

Parameter to_int : forall {A : Set}, num A -> option Z.

Parameter of_int : Z -> num z.

Parameter of_zint : Tezos_protocol_environment_alpha__Environment.Z.t -> num z.

Parameter to_zint : forall {a : Set},
  num a -> Tezos_protocol_environment_alpha__Environment.Z.t.

Parameter add_n : num n -> num n -> num n.

Parameter mul_n : num n -> num n -> num n.

Parameter ediv_n : num n -> num n -> option (num n * num n).

Parameter add : forall {A B : Set}, num A -> num B -> num z.

Parameter sub : forall {A B : Set}, num A -> num B -> num z.

Parameter mul : forall {A B : Set}, num A -> num B -> num z.

Parameter ediv : forall {A B : Set}, num A -> num B -> option (num z * num n).

Parameter abs : num z -> num n.

Parameter is_nat : num z -> option (num n).

Parameter neg : forall {A : Set}, num A -> num z.

Parameter int : num n -> num z.

Parameter lognot : forall {A : Set}, num A -> num z.

Parameter shift_left_n : num n -> num n -> option (num n).

Parameter shift_right_n : num n -> num n -> option (num n).

Parameter shift_left : forall {a : Set}, num a -> num n -> option (num a).

Parameter shift_right : forall {a : Set}, num a -> num n -> option (num a).

Parameter logor : forall {a : Set}, num a -> num a -> num a.

Parameter logand : forall {A : Set}, num A -> num n -> num n.

Parameter logxor : num n -> num n -> num n.

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Alpha_context
open Script
open Script_typed_ir
open Script_ir_translator

(* ---- Run-time errors -----------------------------------------------------*)

type execution_trace =
  (Script.location * Gas.t * (Script.expr * string option) list) list

type error +=
  | Reject of Script.location * Script.expr * execution_trace option

type error += Overflow of Script.location * execution_trace option

type error += Runtime_contract_error : Contract.t * Script.expr -> error

type error += Bad_contract_parameter of Contract.t (* `Permanent *)

type error += Cannot_serialize_log

type error += Cannot_serialize_failure

type error += Cannot_serialize_storage

let () =
  let open Data_encoding in
  let trace_encoding =
    list
    @@ obj3
         (req "location" Script.location_encoding)
         (req "gas" Gas.encoding)
         (req
            "stack"
            (list (obj2 (req "item" Script.expr_encoding) (opt "annot" string))))
  in
  (* Reject *)
  register_error_kind
    `Temporary
    ~id:"michelson_v1.script_rejected"
    ~title:"Script failed"
    ~description:"A FAILWITH instruction was reached"
    (obj3
       (req "location" Script.location_encoding)
       (req "with" Script.expr_encoding)
       (opt "trace" trace_encoding))
    (function Reject (loc, v, trace) -> Some (loc, v, trace) | _ -> None)
    (fun (loc, v, trace) -> Reject (loc, v, trace)) ;
  (* Overflow *)
  register_error_kind
    `Temporary
    ~id:"michelson_v1.script_overflow"
    ~title:"Script failed (overflow error)"
    ~description:
      "A FAIL instruction was reached due to the detection of an overflow"
    (obj2
       (req "location" Script.location_encoding)
       (opt "trace" trace_encoding))
    (function Overflow (loc, trace) -> Some (loc, trace) | _ -> None)
    (fun (loc, trace) -> Overflow (loc, trace)) ;
  (* Runtime contract error *)
  register_error_kind
    `Temporary
    ~id:"michelson_v1.runtime_error"
    ~title:"Script runtime error"
    ~description:"Toplevel error for all runtime script errors"
    (obj2
       (req "contract_handle" Contract.encoding)
       (req "contract_code" Script.expr_encoding))
    (function
      | Runtime_contract_error (contract, expr) ->
          Some (contract, expr)
      | _ ->
          None)
    (fun (contract, expr) -> Runtime_contract_error (contract, expr)) ;
  (* Bad contract parameter *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.bad_contract_parameter"
    ~title:"Contract supplied an invalid parameter"
    ~description:
      "Either no parameter was supplied to a contract with a non-unit \
       parameter type, a non-unit parameter was passed to an account, or a \
       parameter was supplied of the wrong type"
    Data_encoding.(obj1 (req "contract" Contract.encoding))
    (function Bad_contract_parameter c -> Some c | _ -> None)
    (fun c -> Bad_contract_parameter c) ;
  (* Cannot serialize log *)
  register_error_kind
    `Temporary
    ~id:"michelson_v1.cannot_serialize_log"
    ~title:"Not enough gas to serialize execution trace"
    ~description:
      "Execution trace with stacks was to big to be serialized with the \
       provided gas"
    Data_encoding.empty
    (function Cannot_serialize_log -> Some () | _ -> None)
    (fun () -> Cannot_serialize_log) ;
  (* Cannot serialize failure *)
  register_error_kind
    `Temporary
    ~id:"michelson_v1.cannot_serialize_failure"
    ~title:"Not enough gas to serialize argument of FAILWITH"
    ~description:
      "Argument of FAILWITH was too big to be serialized with the provided gas"
    Data_encoding.empty
    (function Cannot_serialize_failure -> Some () | _ -> None)
    (fun () -> Cannot_serialize_failure) ;
  (* Cannot serialize storage *)
  register_error_kind
    `Temporary
    ~id:"michelson_v1.cannot_serialize_storage"
    ~title:"Not enough gas to serialize execution storage"
    ~description:
      "The returned storage was too big to be serialized with the provided gas"
    Data_encoding.empty
    (function Cannot_serialize_storage -> Some () | _ -> None)
    (fun () -> Cannot_serialize_storage)

(* ---- interpreter ---------------------------------------------------------*)

type 'tys stack =
  | Item : 'ty * 'rest stack -> ('ty * 'rest) stack
  | Empty : end_of_stack stack

let unparse_stack ctxt (stack, stack_ty) =
  (* We drop the gas limit as this function is only used for debugging/errors. *)
  let ctxt = Gas.set_unlimited ctxt in
  let rec unparse_stack :
      type a.
      a stack * a stack_ty -> (Script.expr * string option) list tzresult Lwt.t
      = function
    | (Empty, Empty_t) ->
        return_nil
    | (Item (v, rest), Item_t (ty, rest_ty, annot)) ->
        unparse_data ctxt Readable ty v
        >>=? fun (data, _ctxt) ->
        unparse_stack (rest, rest_ty)
        >>=? fun rest ->
        let annot =
          match Script_ir_annot.unparse_var_annot annot with
          | [] ->
              None
          | [a] ->
              Some a
          | _ ->
              assert false
        in
        let data = Micheline.strip_locations data in
        return ((data, annot) :: rest)
  in
  unparse_stack (stack, stack_ty)

module Interp_costs = Michelson_v1_gas.Cost_of.Interpreter

let rec interp_stack_prefix_preserving_operation :
    type fbef bef faft aft result.
    (fbef stack -> (faft stack * result) tzresult Lwt.t) ->
    (fbef, faft, bef, aft) stack_prefix_preservation_witness ->
    bef stack ->
    (aft stack * result) tzresult Lwt.t =
 fun f n stk ->
  match (n, stk) with
  | ( Prefix
        (Prefix
          (Prefix
            (Prefix
              (Prefix
                (Prefix
                  (Prefix
                    (Prefix
                      (Prefix
                        (Prefix
                          (Prefix
                            (Prefix (Prefix (Prefix (Prefix (Prefix n))))))))))))))),
      Item
        ( v0,
          Item
            ( v1,
              Item
                ( v2,
                  Item
                    ( v3,
                      Item
                        ( v4,
                          Item
                            ( v5,
                              Item
                                ( v6,
                                  Item
                                    ( v7,
                                      Item
                                        ( v8,
                                          Item
                                            ( v9,
                                              Item
                                                ( va,
                                                  Item
                                                    ( vb,
                                                      Item
                                                        ( vc,
                                                          Item
                                                            ( vd,
                                                              Item
                                                                ( ve,
                                                                  Item
                                                                    (vf, rest)
                                                                ) ) ) ) ) ) )
                                    ) ) ) ) ) ) ) ) ) ->
      interp_stack_prefix_preserving_operation f n rest
      >>=? fun (rest', result) ->
      return
        ( Item
            ( v0,
              Item
                ( v1,
                  Item
                    ( v2,
                      Item
                        ( v3,
                          Item
                            ( v4,
                              Item
                                ( v5,
                                  Item
                                    ( v6,
                                      Item
                                        ( v7,
                                          Item
                                            ( v8,
                                              Item
                                                ( v9,
                                                  Item
                                                    ( va,
                                                      Item
                                                        ( vb,
                                                          Item
                                                            ( vc,
                                                              Item
                                                                ( vd,
                                                                  Item
                                                                    ( ve,
                                                                      Item
                                                                        ( vf,
                                                                          rest'
                                                                        ) ) )
                                                            ) ) ) ) ) ) ) ) )
                        ) ) ) ),
          result )
  | ( Prefix (Prefix (Prefix (Prefix n))),
      Item (v0, Item (v1, Item (v2, Item (v3, rest)))) ) ->
      interp_stack_prefix_preserving_operation f n rest
      >>=? fun (rest', result) ->
      return (Item (v0, Item (v1, Item (v2, Item (v3, rest')))), result)
  | (Prefix n, Item (v, rest)) ->
      interp_stack_prefix_preserving_operation f n rest
      >>=? fun (rest', result) -> return (Item (v, rest'), result)
  | (Rest, v) ->
      f v

type step_constants = {
  source : Contract.t;
  payer : Contract.t;
  self : Contract.t;
  amount : Tez.t;
  chain_id : Chain_id.t;
}

let rec step :
    type b a.
    ?log:execution_trace ref ->
    context ->
    step_constants ->
    (b, a) descr ->
    b stack ->
    (a stack * context) tzresult Lwt.t =
 fun ?log ctxt step_constants ({instr; loc; _} as descr) stack ->
  Lwt.return (Gas.consume ctxt Interp_costs.cycle)
  >>=? fun ctxt ->
  let logged_return :
      type a b.
      (b, a) descr -> a stack * context -> (a stack * context) tzresult Lwt.t =
   fun descr (ret, ctxt) ->
    match log with
    | None ->
        return (ret, ctxt)
    | Some log ->
        trace Cannot_serialize_log (unparse_stack ctxt (ret, descr.aft))
        >>=? fun stack ->
        log := (descr.loc, Gas.level ctxt, stack) :: !log ;
        return (ret, ctxt)
  in
  let get_log (log : execution_trace ref option) =
    Option.map ~f:(fun l -> List.rev !l) log
  in
  let consume_gas_terop :
      type ret arg1 arg2 arg3 rest.
      (_ * (_ * (_ * rest)), ret * rest) descr ->
      (arg1 -> arg2 -> arg3 -> ret) * arg1 * arg2 * arg3 ->
      (arg1 -> arg2 -> arg3 -> Gas.cost) ->
      rest stack ->
      ((ret * rest) stack * context) tzresult Lwt.t =
   fun descr (op, x1, x2, x3) cost_func rest ->
    Lwt.return (Gas.consume ctxt (cost_func x1 x2 x3))
    >>=? fun ctxt -> logged_return descr (Item (op x1 x2 x3, rest), ctxt)
  in
  let consume_gas_binop :
      type ret arg1 arg2 rest.
      (_ * (_ * rest), ret * rest) descr ->
      (arg1 -> arg2 -> ret) * arg1 * arg2 ->
      (arg1 -> arg2 -> Gas.cost) ->
      rest stack ->
      context ->
      ((ret * rest) stack * context) tzresult Lwt.t =
   fun descr (op, x1, x2) cost_func rest ctxt ->
    Lwt.return (Gas.consume ctxt (cost_func x1 x2))
    >>=? fun ctxt -> logged_return descr (Item (op x1 x2, rest), ctxt)
  in
  let consume_gas_unop :
      type ret arg rest.
      (_ * rest, ret * rest) descr ->
      (arg -> ret) * arg ->
      (arg -> Gas.cost) ->
      rest stack ->
      context ->
      ((ret * rest) stack * context) tzresult Lwt.t =
   fun descr (op, arg) cost_func rest ctxt ->
    Lwt.return (Gas.consume ctxt (cost_func arg))
    >>=? fun ctxt -> logged_return descr (Item (op arg, rest), ctxt)
  in
  let logged_return : a stack * context -> (a stack * context) tzresult Lwt.t =
    logged_return descr
  in
  match (instr, stack) with
  (* stack ops *)
  | (Drop, Item (_, rest)) ->
      Lwt.return (Gas.consume ctxt Interp_costs.stack_op)
      >>=? fun ctxt -> logged_return (rest, ctxt)
  | (Dup, Item (v, rest)) ->
      Lwt.return (Gas.consume ctxt Interp_costs.stack_op)
      >>=? fun ctxt -> logged_return (Item (v, Item (v, rest)), ctxt)
  | (Swap, Item (vi, Item (vo, rest))) ->
      Lwt.return (Gas.consume ctxt Interp_costs.stack_op)
      >>=? fun ctxt -> logged_return (Item (vo, Item (vi, rest)), ctxt)
  | (Const v, rest) ->
      Lwt.return (Gas.consume ctxt Interp_costs.push)
      >>=? fun ctxt -> logged_return (Item (v, rest), ctxt)
  (* options *)
  | (Cons_some, Item (v, rest)) ->
      Lwt.return (Gas.consume ctxt Interp_costs.wrap)
      >>=? fun ctxt -> logged_return (Item (Some v, rest), ctxt)
  | (Cons_none _, rest) ->
      Lwt.return (Gas.consume ctxt Interp_costs.variant_no_data)
      >>=? fun ctxt -> logged_return (Item (None, rest), ctxt)
  | (If_none (bt, _), Item (None, rest)) ->
      Lwt.return (Gas.consume ctxt Interp_costs.branch)
      >>=? fun ctxt -> step ?log ctxt step_constants bt rest
  | (If_none (_, bf), Item (Some v, rest)) ->
      Lwt.return (Gas.consume ctxt Interp_costs.branch)
      >>=? fun ctxt -> step ?log ctxt step_constants bf (Item (v, rest))
  (* pairs *)
  | (Cons_pair, Item (a, Item (b, rest))) ->
      Lwt.return (Gas.consume ctxt Interp_costs.pair)
      >>=? fun ctxt -> logged_return (Item ((a, b), rest), ctxt)
  (* Peephole optimization for UNPAIR *)
  | ( Seq
        ( {instr = Dup; _},
          { instr =
              Seq
                ( {instr = Car; _},
                  { instr = Seq ({instr = Dip {instr = Cdr}}, {instr = Nop; _});
                    _ } );
            _ } ),
      Item ((a, b), rest) ) ->
      Lwt.return (Gas.consume ctxt Interp_costs.pair_access)
      >>=? fun ctxt -> logged_return (Item (a, Item (b, rest)), ctxt)
  | (Car, Item ((a, _), rest)) ->
      Lwt.return (Gas.consume ctxt Interp_costs.pair_access)
      >>=? fun ctxt -> logged_return (Item (a, rest), ctxt)
  | (Cdr, Item ((_, b), rest)) ->
      Lwt.return (Gas.consume ctxt Interp_costs.pair_access)
      >>=? fun ctxt -> logged_return (Item (b, rest), ctxt)
  (* unions *)
  | (Left, Item (v, rest)) ->
      Lwt.return (Gas.consume ctxt Interp_costs.wrap)
      >>=? fun ctxt -> logged_return (Item (L v, rest), ctxt)
  | (Right, Item (v, rest)) ->
      Lwt.return (Gas.consume ctxt Interp_costs.wrap)
      >>=? fun ctxt -> logged_return (Item (R v, rest), ctxt)
  | (If_left (bt, _), Item (L v, rest)) ->
      Lwt.return (Gas.consume ctxt Interp_costs.branch)
      >>=? fun ctxt -> step ?log ctxt step_constants bt (Item (v, rest))
  | (If_left (_, bf), Item (R v, rest)) ->
      Lwt.return (Gas.consume ctxt Interp_costs.branch)
      >>=? fun ctxt -> step ?log ctxt step_constants bf (Item (v, rest))
  (* lists *)
  | (Cons_list, Item (hd, Item (tl, rest))) ->
      Lwt.return (Gas.consume ctxt Interp_costs.cons)
      >>=? fun ctxt -> logged_return (Item (hd :: tl, rest), ctxt)
  | (Nil, rest) ->
      Lwt.return (Gas.consume ctxt Interp_costs.variant_no_data)
      >>=? fun ctxt -> logged_return (Item ([], rest), ctxt)
  | (If_cons (_, bf), Item ([], rest)) ->
      Lwt.return (Gas.consume ctxt Interp_costs.branch)
      >>=? fun ctxt -> step ?log ctxt step_constants bf rest
  | (If_cons (bt, _), Item (hd :: tl, rest)) ->
      Lwt.return (Gas.consume ctxt Interp_costs.branch)
      >>=? fun ctxt ->
      step ?log ctxt step_constants bt (Item (hd, Item (tl, rest)))
  | (List_map body, Item (l, rest)) ->
      let rec loop rest ctxt l acc =
        Lwt.return (Gas.consume ctxt Interp_costs.loop_map)
        >>=? fun ctxt ->
        match l with
        | [] ->
            return (Item (List.rev acc, rest), ctxt)
        | hd :: tl ->
            step ?log ctxt step_constants body (Item (hd, rest))
            >>=? fun (Item (hd, rest), ctxt) -> loop rest ctxt tl (hd :: acc)
      in
      loop rest ctxt l [] >>=? fun (res, ctxt) -> logged_return (res, ctxt)
  | (List_size, Item (list, rest)) ->
      Lwt.return
        (List.fold_left
           (fun acc _ ->
             acc
             >>? fun (size, ctxt) ->
             Gas.consume ctxt Interp_costs.loop_size
             >>? fun ctxt -> ok (size + 1 (* FIXME: overflow *), ctxt))
           (ok (0, ctxt))
           list)
      >>=? fun (len, ctxt) ->
      logged_return (Item (Script_int.(abs (of_int len)), rest), ctxt)
  | (List_iter body, Item (l, init)) ->
      let rec loop ctxt l stack =
        Lwt.return (Gas.consume ctxt Interp_costs.loop_iter)
        >>=? fun ctxt ->
        match l with
        | [] ->
            return (stack, ctxt)
        | hd :: tl ->
            step ?log ctxt step_constants body (Item (hd, stack))
            >>=? fun (stack, ctxt) -> loop ctxt tl stack
      in
      loop ctxt l init >>=? fun (res, ctxt) -> logged_return (res, ctxt)
  (* sets *)
  | (Empty_set t, rest) ->
      Lwt.return (Gas.consume ctxt Interp_costs.empty_set)
      >>=? fun ctxt -> logged_return (Item (empty_set t, rest), ctxt)
  | (Set_iter body, Item (set, init)) ->
      Lwt.return (Gas.consume ctxt (Interp_costs.set_to_list set))
      >>=? fun ctxt ->
      let l = List.rev (set_fold (fun e acc -> e :: acc) set []) in
      let rec loop ctxt l stack =
        Lwt.return (Gas.consume ctxt Interp_costs.loop_iter)
        >>=? fun ctxt ->
        match l with
        | [] ->
            return (stack, ctxt)
        | hd :: tl ->
            step ?log ctxt step_constants body (Item (hd, stack))
            >>=? fun (stack, ctxt) -> loop ctxt tl stack
      in
      loop ctxt l init >>=? fun (res, ctxt) -> logged_return (res, ctxt)
  | (Set_mem, Item (v, Item (set, rest))) ->
      consume_gas_binop descr (set_mem, v, set) Interp_costs.set_mem rest ctxt
  | (Set_update, Item (v, Item (presence, Item (set, rest)))) ->
      consume_gas_terop
        descr
        (set_update, v, presence, set)
        Interp_costs.set_update
        rest
  | (Set_size, Item (set, rest)) ->
      consume_gas_unop
        descr
        (set_size, set)
        (fun _ -> Interp_costs.set_size)
        rest
        ctxt
  (* maps *)
  | (Empty_map (t, _), rest) ->
      Lwt.return (Gas.consume ctxt Interp_costs.empty_map)
      >>=? fun ctxt -> logged_return (Item (empty_map t, rest), ctxt)
  | (Map_map body, Item (map, rest)) ->
      Lwt.return (Gas.consume ctxt (Interp_costs.map_to_list map))
      >>=? fun ctxt ->
      let l = List.rev (map_fold (fun k v acc -> (k, v) :: acc) map []) in
      let rec loop rest ctxt l acc =
        Lwt.return (Gas.consume ctxt Interp_costs.loop_map)
        >>=? fun ctxt ->
        match l with
        | [] ->
            return (acc, ctxt)
        | ((k, _) as hd) :: tl ->
            step ?log ctxt step_constants body (Item (hd, rest))
            >>=? fun (Item (hd, rest), ctxt) ->
            loop rest ctxt tl (map_update k (Some hd) acc)
      in
      loop rest ctxt l (empty_map (map_key_ty map))
      >>=? fun (res, ctxt) -> logged_return (Item (res, rest), ctxt)
  | (Map_iter body, Item (map, init)) ->
      Lwt.return (Gas.consume ctxt (Interp_costs.map_to_list map))
      >>=? fun ctxt ->
      let l = List.rev (map_fold (fun k v acc -> (k, v) :: acc) map []) in
      let rec loop ctxt l stack =
        Lwt.return (Gas.consume ctxt Interp_costs.loop_iter)
        >>=? fun ctxt ->
        match l with
        | [] ->
            return (stack, ctxt)
        | hd :: tl ->
            step ?log ctxt step_constants body (Item (hd, stack))
            >>=? fun (stack, ctxt) -> loop ctxt tl stack
      in
      loop ctxt l init >>=? fun (res, ctxt) -> logged_return (res, ctxt)
  | (Map_mem, Item (v, Item (map, rest))) ->
      consume_gas_binop descr (map_mem, v, map) Interp_costs.map_mem rest ctxt
  | (Map_get, Item (v, Item (map, rest))) ->
      consume_gas_binop descr (map_get, v, map) Interp_costs.map_get rest ctxt
  | (Map_update, Item (k, Item (v, Item (map, rest)))) ->
      consume_gas_terop
        descr
        (map_update, k, v, map)
        Interp_costs.map_update
        rest
  | (Map_size, Item (map, rest)) ->
      consume_gas_unop
        descr
        (map_size, map)
        (fun _ -> Interp_costs.map_size)
        rest
        ctxt
  (* Big map operations *)
  | (Empty_big_map (tk, tv), rest) ->
      Lwt.return (Gas.consume ctxt Interp_costs.empty_map)
      >>=? fun ctxt ->
      logged_return
        (Item (Script_ir_translator.empty_big_map tk tv, rest), ctxt)
  | (Big_map_mem, Item (key, Item (map, rest))) ->
      Lwt.return (Gas.consume ctxt (Interp_costs.map_mem key map.diff))
      >>=? fun ctxt ->
      Script_ir_translator.big_map_mem ctxt key map
      >>=? fun (res, ctxt) -> logged_return (Item (res, rest), ctxt)
  | (Big_map_get, Item (key, Item (map, rest))) ->
      Lwt.return (Gas.consume ctxt (Interp_costs.map_get key map.diff))
      >>=? fun ctxt ->
      Script_ir_translator.big_map_get ctxt key map
      >>=? fun (res, ctxt) -> logged_return (Item (res, rest), ctxt)
  | (Big_map_update, Item (key, Item (maybe_value, Item (map, rest)))) ->
      consume_gas_terop
        descr
        (Script_ir_translator.big_map_update, key, maybe_value, map)
        (fun k v m -> Interp_costs.map_update k (Some v) m.diff)
        rest
  (* timestamp operations *)
  | (Add_seconds_to_timestamp, Item (n, Item (t, rest))) ->
      consume_gas_binop
        descr
        (Script_timestamp.add_delta, t, n)
        Interp_costs.add_timestamp
        rest
        ctxt
  | (Add_timestamp_to_seconds, Item (t, Item (n, rest))) ->
      consume_gas_binop
        descr
        (Script_timestamp.add_delta, t, n)
        Interp_costs.add_timestamp
        rest
        ctxt
  | (Sub_timestamp_seconds, Item (t, Item (s, rest))) ->
      consume_gas_binop
        descr
        (Script_timestamp.sub_delta, t, s)
        Interp_costs.sub_timestamp
        rest
        ctxt
  | (Diff_timestamps, Item (t1, Item (t2, rest))) ->
      consume_gas_binop
        descr
        (Script_timestamp.diff, t1, t2)
        Interp_costs.diff_timestamps
        rest
        ctxt
  (* string operations *)
  | (Concat_string_pair, Item (x, Item (y, rest))) ->
      Lwt.return (Gas.consume ctxt (Interp_costs.concat_string [x; y]))
      >>=? fun ctxt ->
      let s = String.concat "" [x; y] in
      logged_return (Item (s, rest), ctxt)
  | (Concat_string, Item (ss, rest)) ->
      Lwt.return (Gas.consume ctxt (Interp_costs.concat_string ss))
      >>=? fun ctxt ->
      let s = String.concat "" ss in
      logged_return (Item (s, rest), ctxt)
  | (Slice_string, Item (offset, Item (length, Item (s, rest)))) ->
      let s_length = Z.of_int (String.length s) in
      let offset = Script_int.to_zint offset in
      let length = Script_int.to_zint length in
      if Compare.Z.(offset < s_length && Z.add offset length <= s_length) then
        Lwt.return
          (Gas.consume ctxt (Interp_costs.slice_string (Z.to_int length)))
        >>=? fun ctxt ->
        logged_return
          ( Item (Some (String.sub s (Z.to_int offset) (Z.to_int length)), rest),
            ctxt )
      else
        Lwt.return (Gas.consume ctxt (Interp_costs.slice_string 0))
        >>=? fun ctxt -> logged_return (Item (None, rest), ctxt)
  | (String_size, Item (s, rest)) ->
      Lwt.return (Gas.consume ctxt Interp_costs.push)
      >>=? fun ctxt ->
      logged_return
        (Item (Script_int.(abs (of_int (String.length s))), rest), ctxt)
  (* bytes operations *)
  | (Concat_bytes_pair, Item (x, Item (y, rest))) ->
      Lwt.return (Gas.consume ctxt (Interp_costs.concat_bytes [x; y]))
      >>=? fun ctxt ->
      let s = MBytes.concat "" [x; y] in
      logged_return (Item (s, rest), ctxt)
  | (Concat_bytes, Item (ss, rest)) ->
      Lwt.return (Gas.consume ctxt (Interp_costs.concat_bytes ss))
      >>=? fun ctxt ->
      let s = MBytes.concat "" ss in
      logged_return (Item (s, rest), ctxt)
  | (Slice_bytes, Item (offset, Item (length, Item (s, rest)))) ->
      let s_length = Z.of_int (MBytes.length s) in
      let offset = Script_int.to_zint offset in
      let length = Script_int.to_zint length in
      if Compare.Z.(offset < s_length && Z.add offset length <= s_length) then
        Lwt.return
          (Gas.consume ctxt (Interp_costs.slice_string (Z.to_int length)))
        >>=? fun ctxt ->
        logged_return
          ( Item (Some (MBytes.sub s (Z.to_int offset) (Z.to_int length)), rest),
            ctxt )
      else
        Lwt.return (Gas.consume ctxt (Interp_costs.slice_string 0))
        >>=? fun ctxt -> logged_return (Item (None, rest), ctxt)
  | (Bytes_size, Item (s, rest)) ->
      Lwt.return (Gas.consume ctxt Interp_costs.push)
      >>=? fun ctxt ->
      logged_return
        (Item (Script_int.(abs (of_int (MBytes.length s))), rest), ctxt)
  (* currency operations *)
  | (Add_tez, Item (x, Item (y, rest))) ->
      Lwt.return (Gas.consume ctxt Interp_costs.int64_op)
      >>=? fun ctxt ->
      Lwt.return Tez.(x +? y)
      >>=? fun res -> logged_return (Item (res, rest), ctxt)
  | (Sub_tez, Item (x, Item (y, rest))) ->
      Lwt.return (Gas.consume ctxt Interp_costs.int64_op)
      >>=? fun ctxt ->
      Lwt.return Tez.(x -? y)
      >>=? fun res -> logged_return (Item (res, rest), ctxt)
  | (Mul_teznat, Item (x, Item (y, rest))) -> (
      Lwt.return (Gas.consume ctxt Interp_costs.int64_op)
      >>=? fun ctxt ->
      Lwt.return (Gas.consume ctxt Interp_costs.z_to_int64)
      >>=? fun ctxt ->
      match Script_int.to_int64 y with
      | None ->
          fail (Overflow (loc, get_log log))
      | Some y ->
          Lwt.return Tez.(x *? y)
          >>=? fun res -> logged_return (Item (res, rest), ctxt) )
  | (Mul_nattez, Item (y, Item (x, rest))) -> (
      Lwt.return (Gas.consume ctxt Interp_costs.int64_op)
      >>=? fun ctxt ->
      Lwt.return (Gas.consume ctxt Interp_costs.z_to_int64)
      >>=? fun ctxt ->
      match Script_int.to_int64 y with
      | None ->
          fail (Overflow (loc, get_log log))
      | Some y ->
          Lwt.return Tez.(x *? y)
          >>=? fun res -> logged_return (Item (res, rest), ctxt) )
  (* boolean operations *)
  | (Or, Item (x, Item (y, rest))) ->
      consume_gas_binop descr (( || ), x, y) Interp_costs.bool_binop rest ctxt
  | (And, Item (x, Item (y, rest))) ->
      consume_gas_binop descr (( && ), x, y) Interp_costs.bool_binop rest ctxt
  | (Xor, Item (x, Item (y, rest))) ->
      consume_gas_binop
        descr
        (Compare.Bool.( <> ), x, y)
        Interp_costs.bool_binop
        rest
        ctxt
  | (Not, Item (x, rest)) ->
      consume_gas_unop descr (not, x) Interp_costs.bool_unop rest ctxt
  (* integer operations *)
  | (Is_nat, Item (x, rest)) ->
      consume_gas_unop descr (Script_int.is_nat, x) Interp_costs.abs rest ctxt
  | (Abs_int, Item (x, rest)) ->
      consume_gas_unop descr (Script_int.abs, x) Interp_costs.abs rest ctxt
  | (Int_nat, Item (x, rest)) ->
      consume_gas_unop descr (Script_int.int, x) Interp_costs.int rest ctxt
  | (Neg_int, Item (x, rest)) ->
      consume_gas_unop descr (Script_int.neg, x) Interp_costs.neg rest ctxt
  | (Neg_nat, Item (x, rest)) ->
      consume_gas_unop descr (Script_int.neg, x) Interp_costs.neg rest ctxt
  | (Add_intint, Item (x, Item (y, rest))) ->
      consume_gas_binop descr (Script_int.add, x, y) Interp_costs.add rest ctxt
  | (Add_intnat, Item (x, Item (y, rest))) ->
      consume_gas_binop descr (Script_int.add, x, y) Interp_costs.add rest ctxt
  | (Add_natint, Item (x, Item (y, rest))) ->
      consume_gas_binop descr (Script_int.add, x, y) Interp_costs.add rest ctxt
  | (Add_natnat, Item (x, Item (y, rest))) ->
      consume_gas_binop
        descr
        (Script_int.add_n, x, y)
        Interp_costs.add
        rest
        ctxt
  | (Sub_int, Item (x, Item (y, rest))) ->
      consume_gas_binop descr (Script_int.sub, x, y) Interp_costs.sub rest ctxt
  | (Mul_intint, Item (x, Item (y, rest))) ->
      consume_gas_binop descr (Script_int.mul, x, y) Interp_costs.mul rest ctxt
  | (Mul_intnat, Item (x, Item (y, rest))) ->
      consume_gas_binop descr (Script_int.mul, x, y) Interp_costs.mul rest ctxt
  | (Mul_natint, Item (x, Item (y, rest))) ->
      consume_gas_binop descr (Script_int.mul, x, y) Interp_costs.mul rest ctxt
  | (Mul_natnat, Item (x, Item (y, rest))) ->
      consume_gas_binop
        descr
        (Script_int.mul_n, x, y)
        Interp_costs.mul
        rest
        ctxt
  | (Ediv_teznat, Item (x, Item (y, rest))) ->
      Lwt.return (Gas.consume ctxt Interp_costs.int64_to_z)
      >>=? fun ctxt ->
      let x = Script_int.of_int64 (Tez.to_mutez x) in
      consume_gas_binop
        descr
        ( (fun x y ->
            match Script_int.ediv x y with
            | None ->
                None
            | Some (q, r) -> (
              match (Script_int.to_int64 q, Script_int.to_int64 r) with
              | (Some q, Some r) -> (
                match (Tez.of_mutez q, Tez.of_mutez r) with
                | (Some q, Some r) ->
                    Some (q, r)
                (* Cannot overflow *)
                | _ ->
                    assert false )
              (* Cannot overflow *)
              | _ ->
                  assert false )),
          x,
          y )
        Interp_costs.div
        rest
        ctxt
  | (Ediv_tez, Item (x, Item (y, rest))) ->
      Lwt.return (Gas.consume ctxt Interp_costs.int64_to_z)
      >>=? fun ctxt ->
      Lwt.return (Gas.consume ctxt Interp_costs.int64_to_z)
      >>=? fun ctxt ->
      let x = Script_int.abs (Script_int.of_int64 (Tez.to_mutez x)) in
      let y = Script_int.abs (Script_int.of_int64 (Tez.to_mutez y)) in
      consume_gas_binop
        descr
        ( (fun x y ->
            match Script_int.ediv_n x y with
            | None ->
                None
            | Some (q, r) -> (
              match Script_int.to_int64 r with
              | None ->
                  assert false (* Cannot overflow *)
              | Some r -> (
                match Tez.of_mutez r with
                | None ->
                    assert false (* Cannot overflow *)
                | Some r ->
                    Some (q, r) ) )),
          x,
          y )
        Interp_costs.div
        rest
        ctxt
  | (Ediv_intint, Item (x, Item (y, rest))) ->
      consume_gas_binop
        descr
        (Script_int.ediv, x, y)
        Interp_costs.div
        rest
        ctxt
  | (Ediv_intnat, Item (x, Item (y, rest))) ->
      consume_gas_binop
        descr
        (Script_int.ediv, x, y)
        Interp_costs.div
        rest
        ctxt
  | (Ediv_natint, Item (x, Item (y, rest))) ->
      consume_gas_binop
        descr
        (Script_int.ediv, x, y)
        Interp_costs.div
        rest
        ctxt
  | (Ediv_natnat, Item (x, Item (y, rest))) ->
      consume_gas_binop
        descr
        (Script_int.ediv_n, x, y)
        Interp_costs.div
        rest
        ctxt
  | (Lsl_nat, Item (x, Item (y, rest))) -> (
      Lwt.return (Gas.consume ctxt (Interp_costs.shift_left x y))
      >>=? fun ctxt ->
      match Script_int.shift_left_n x y with
      | None ->
          fail (Overflow (loc, get_log log))
      | Some x ->
          logged_return (Item (x, rest), ctxt) )
  | (Lsr_nat, Item (x, Item (y, rest))) -> (
      Lwt.return (Gas.consume ctxt (Interp_costs.shift_right x y))
      >>=? fun ctxt ->
      match Script_int.shift_right_n x y with
      | None ->
          fail (Overflow (loc, get_log log))
      | Some r ->
          logged_return (Item (r, rest), ctxt) )
  | (Or_nat, Item (x, Item (y, rest))) ->
      consume_gas_binop
        descr
        (Script_int.logor, x, y)
        Interp_costs.logor
        rest
        ctxt
  | (And_nat, Item (x, Item (y, rest))) ->
      consume_gas_binop
        descr
        (Script_int.logand, x, y)
        Interp_costs.logand
        rest
        ctxt
  | (And_int_nat, Item (x, Item (y, rest))) ->
      consume_gas_binop
        descr
        (Script_int.logand, x, y)
        Interp_costs.logand
        rest
        ctxt
  | (Xor_nat, Item (x, Item (y, rest))) ->
      consume_gas_binop
        descr
        (Script_int.logxor, x, y)
        Interp_costs.logxor
        rest
        ctxt
  | (Not_int, Item (x, rest)) ->
      consume_gas_unop
        descr
        (Script_int.lognot, x)
        Interp_costs.lognot
        rest
        ctxt
  | (Not_nat, Item (x, rest)) ->
      consume_gas_unop
        descr
        (Script_int.lognot, x)
        Interp_costs.lognot
        rest
        ctxt
  (* control *)
  | (Seq (hd, tl), stack) ->
      step ?log ctxt step_constants hd stack
      >>=? fun (trans, ctxt) -> step ?log ctxt step_constants tl trans
  | (If (bt, _), Item (true, rest)) ->
      Lwt.return (Gas.consume ctxt Interp_costs.branch)
      >>=? fun ctxt -> step ?log ctxt step_constants bt rest
  | (If (_, bf), Item (false, rest)) ->
      Lwt.return (Gas.consume ctxt Interp_costs.branch)
      >>=? fun ctxt -> step ?log ctxt step_constants bf rest
  | (Loop body, Item (true, rest)) ->
      Lwt.return (Gas.consume ctxt Interp_costs.loop_cycle)
      >>=? fun ctxt ->
      step ?log ctxt step_constants body rest
      >>=? fun (trans, ctxt) -> step ?log ctxt step_constants descr trans
  | (Loop _, Item (false, rest)) ->
      logged_return (rest, ctxt)
  | (Loop_left body, Item (L v, rest)) ->
      Lwt.return (Gas.consume ctxt Interp_costs.loop_cycle)
      >>=? fun ctxt ->
      step ?log ctxt step_constants body (Item (v, rest))
      >>=? fun (trans, ctxt) -> step ?log ctxt step_constants descr trans
  | (Loop_left _, Item (R v, rest)) ->
      Lwt.return (Gas.consume ctxt Interp_costs.loop_cycle)
      >>=? fun ctxt -> logged_return (Item (v, rest), ctxt)
  | (Dip b, Item (ign, rest)) ->
      Lwt.return (Gas.consume ctxt Interp_costs.stack_op)
      >>=? fun ctxt ->
      step ?log ctxt step_constants b rest
      >>=? fun (res, ctxt) -> logged_return (Item (ign, res), ctxt)
  | (Exec, Item (arg, Item (lam, rest))) ->
      Lwt.return (Gas.consume ctxt Interp_costs.exec)
      >>=? fun ctxt ->
      interp ?log ctxt step_constants lam arg
      >>=? fun (res, ctxt) -> logged_return (Item (res, rest), ctxt)
  | (Apply capture_ty, Item (capture, Item (lam, rest))) -> (
      Lwt.return (Gas.consume ctxt Interp_costs.apply)
      >>=? fun ctxt ->
      let (Lam (descr, expr)) = lam in
      let (Item_t (full_arg_ty, _, _)) = descr.bef in
      unparse_data ctxt Optimized capture_ty capture
      >>=? fun (const_expr, ctxt) ->
      unparse_ty ctxt capture_ty
      >>=? fun (ty_expr, ctxt) ->
      match full_arg_ty with
      | Pair_t ((capture_ty, _, _), (arg_ty, _, _), _, _) ->
          let arg_stack_ty = Item_t (arg_ty, Empty_t, None) in
          let const_descr =
            ( {
                loc = descr.loc;
                bef = arg_stack_ty;
                aft = Item_t (capture_ty, arg_stack_ty, None);
                instr = Const capture;
              }
              : (_, _) descr )
          in
          let pair_descr =
            ( {
                loc = descr.loc;
                bef = Item_t (capture_ty, arg_stack_ty, None);
                aft = Item_t (full_arg_ty, Empty_t, None);
                instr = Cons_pair;
              }
              : (_, _) descr )
          in
          let seq_descr =
            ( {
                loc = descr.loc;
                bef = arg_stack_ty;
                aft = Item_t (full_arg_ty, Empty_t, None);
                instr = Seq (const_descr, pair_descr);
              }
              : (_, _) descr )
          in
          let full_descr =
            ( {
                loc = descr.loc;
                bef = arg_stack_ty;
                aft = descr.aft;
                instr = Seq (seq_descr, descr);
              }
              : (_, _) descr )
          in
          let full_expr =
            Micheline.Seq
              ( 0,
                [ Prim (0, I_PUSH, [ty_expr; const_expr], []);
                  Prim (0, I_PAIR, [], []);
                  expr ] )
          in
          let lam' = Lam (full_descr, full_expr) in
          logged_return (Item (lam', rest), ctxt)
      | _ ->
          assert false )
  | (Lambda lam, rest) ->
      Lwt.return (Gas.consume ctxt Interp_costs.push)
      >>=? fun ctxt -> logged_return (Item (lam, rest), ctxt)
  | (Failwith tv, Item (v, _)) ->
      trace Cannot_serialize_failure (unparse_data ctxt Optimized tv v)
      >>=? fun (v, _ctxt) ->
      let v = Micheline.strip_locations v in
      fail (Reject (loc, v, get_log log))
  | (Nop, stack) ->
      logged_return (stack, ctxt)
  (* comparison *)
  | (Compare ty, Item (a, Item (b, rest))) ->
      Lwt.return (Gas.consume ctxt (Interp_costs.compare ty a b))
      >>=? fun ctxt ->
      logged_return
        ( Item
            ( Script_int.of_int
              @@ Script_ir_translator.compare_comparable ty a b,
              rest ),
          ctxt )
  (* comparators *)
  | (Eq, Item (cmpres, rest)) ->
      let cmpres = Script_int.compare cmpres Script_int.zero in
      let cmpres = Compare.Int.(cmpres = 0) in
      Lwt.return (Gas.consume ctxt Interp_costs.compare_res)
      >>=? fun ctxt -> logged_return (Item (cmpres, rest), ctxt)
  | (Neq, Item (cmpres, rest)) ->
      let cmpres = Script_int.compare cmpres Script_int.zero in
      let cmpres = Compare.Int.(cmpres <> 0) in
      Lwt.return (Gas.consume ctxt Interp_costs.compare_res)
      >>=? fun ctxt -> logged_return (Item (cmpres, rest), ctxt)
  | (Lt, Item (cmpres, rest)) ->
      let cmpres = Script_int.compare cmpres Script_int.zero in
      let cmpres = Compare.Int.(cmpres < 0) in
      Lwt.return (Gas.consume ctxt Interp_costs.compare_res)
      >>=? fun ctxt -> logged_return (Item (cmpres, rest), ctxt)
  | (Le, Item (cmpres, rest)) ->
      let cmpres = Script_int.compare cmpres Script_int.zero in
      let cmpres = Compare.Int.(cmpres <= 0) in
      Lwt.return (Gas.consume ctxt Interp_costs.compare_res)
      >>=? fun ctxt -> logged_return (Item (cmpres, rest), ctxt)
  | (Gt, Item (cmpres, rest)) ->
      let cmpres = Script_int.compare cmpres Script_int.zero in
      let cmpres = Compare.Int.(cmpres > 0) in
      Lwt.return (Gas.consume ctxt Interp_costs.compare_res)
      >>=? fun ctxt -> logged_return (Item (cmpres, rest), ctxt)
  | (Ge, Item (cmpres, rest)) ->
      let cmpres = Script_int.compare cmpres Script_int.zero in
      let cmpres = Compare.Int.(cmpres >= 0) in
      Lwt.return (Gas.consume ctxt Interp_costs.compare_res)
      >>=? fun ctxt -> logged_return (Item (cmpres, rest), ctxt)
  (* packing *)
  | (Pack t, Item (value, rest)) ->
      Script_ir_translator.pack_data ctxt t value
      >>=? fun (bytes, ctxt) -> logged_return (Item (bytes, rest), ctxt)
  | (Unpack t, Item (bytes, rest)) ->
      Lwt.return (Gas.check_enough ctxt (Script.serialized_cost bytes))
      >>=? fun () ->
      if
        Compare.Int.(MBytes.length bytes >= 1)
        && Compare.Int.(MBytes.get_uint8 bytes 0 = 0x05)
      then
        let bytes = MBytes.sub bytes 1 (MBytes.length bytes - 1) in
        match Data_encoding.Binary.of_bytes Script.expr_encoding bytes with
        | None ->
            Lwt.return (Gas.consume ctxt (Interp_costs.unpack_failed bytes))
            >>=? fun ctxt -> logged_return (Item (None, rest), ctxt)
        | Some expr -> (
            Lwt.return (Gas.consume ctxt (Script.deserialized_cost expr))
            >>=? fun ctxt ->
            parse_data ctxt ~legacy:false t (Micheline.root expr)
            >>= function
            | Ok (value, ctxt) ->
                logged_return (Item (Some value, rest), ctxt)
            | Error _ignored ->
                Lwt.return
                  (Gas.consume ctxt (Interp_costs.unpack_failed bytes))
                >>=? fun ctxt -> logged_return (Item (None, rest), ctxt) )
      else logged_return (Item (None, rest), ctxt)
  (* protocol *)
  | (Address, Item ((_, address), rest)) ->
      Lwt.return (Gas.consume ctxt Interp_costs.address)
      >>=? fun ctxt -> logged_return (Item (address, rest), ctxt)
  | (Contract (t, entrypoint), Item (contract, rest)) -> (
      Lwt.return (Gas.consume ctxt Interp_costs.contract)
      >>=? fun ctxt ->
      match (contract, entrypoint) with
      | ((contract, "default"), entrypoint)
      | ((contract, entrypoint), "default") ->
          Script_ir_translator.parse_contract_for_script
            ~legacy:false
            ctxt
            loc
            t
            contract
            ~entrypoint
          >>=? fun (ctxt, maybe_contract) ->
          logged_return (Item (maybe_contract, rest), ctxt)
      | _ ->
          logged_return (Item (None, rest), ctxt) )
  | ( Transfer_tokens,
      Item (p, Item (amount, Item ((tp, (destination, entrypoint)), rest))) )
    ->
      Lwt.return (Gas.consume ctxt Interp_costs.transfer)
      >>=? fun ctxt ->
      collect_big_maps ctxt tp p
      >>=? fun (to_duplicate, ctxt) ->
      let to_update = no_big_map_id in
      extract_big_map_diff
        ctxt
        Optimized
        tp
        p
        ~to_duplicate
        ~to_update
        ~temporary:true
      >>=? fun (p, big_map_diff, ctxt) ->
      unparse_data ctxt Optimized tp p
      >>=? fun (p, ctxt) ->
      let operation =
        Transaction
          {
            amount;
            destination;
            entrypoint;
            parameters = Script.lazy_expr (Micheline.strip_locations p);
          }
      in
      Lwt.return (fresh_internal_nonce ctxt)
      >>=? fun (ctxt, nonce) ->
      logged_return
        ( Item
            ( ( Internal_operation
                  {source = step_constants.self; operation; nonce},
                big_map_diff ),
              rest ),
          ctxt )
  | ( Create_account,
      Item (manager, Item (delegate, Item (_delegatable, Item (credit, rest))))
    ) ->
      Lwt.return (Gas.consume ctxt Interp_costs.create_account)
      >>=? fun ctxt ->
      Contract.fresh_contract_from_current_nonce ctxt
      >>=? fun (ctxt, contract) ->
      (* store in optimized binary representation - as unparsed with [Optimized]. *)
      let manager_bytes =
        Data_encoding.Binary.to_bytes_exn
          Signature.Public_key_hash.encoding
          manager
      in
      let storage =
        Script_repr.lazy_expr @@ Micheline.strip_locations
        @@ Micheline.Bytes (0, manager_bytes)
      in
      let script = {code = Legacy_support.manager_script_code; storage} in
      let operation =
        Origination {credit; delegate; preorigination = Some contract; script}
      in
      Lwt.return (fresh_internal_nonce ctxt)
      >>=? fun (ctxt, nonce) ->
      logged_return
        ( Item
            ( ( Internal_operation
                  {source = step_constants.self; operation; nonce},
                None ),
              Item ((contract, "default"), rest) ),
          ctxt )
  | (Implicit_account, Item (key, rest)) ->
      Lwt.return (Gas.consume ctxt Interp_costs.implicit_account)
      >>=? fun ctxt ->
      let contract = Contract.implicit_contract key in
      logged_return (Item ((Unit_t None, (contract, "default")), rest), ctxt)
  | ( Create_contract (storage_type, param_type, Lam (_, code), root_name),
      Item
        ( manager,
          Item
            ( delegate,
              Item
                ( spendable,
                  Item (delegatable, Item (credit, Item (init, rest))) ) ) ) )
    ->
      Lwt.return (Gas.consume ctxt Interp_costs.create_contract)
      >>=? fun ctxt ->
      unparse_ty ctxt param_type
      >>=? fun (unparsed_param_type, ctxt) ->
      let unparsed_param_type =
        Script_ir_translator.add_field_annot
          (Option.map ~f:(fun n -> `Field_annot n) root_name)
          None
          unparsed_param_type
      in
      unparse_ty ctxt storage_type
      >>=? fun (unparsed_storage_type, ctxt) ->
      let code =
        Script.lazy_expr
        @@ Micheline.strip_locations
             (Seq
                ( 0,
                  [ Prim (0, K_parameter, [unparsed_param_type], []);
                    Prim (0, K_storage, [unparsed_storage_type], []);
                    Prim (0, K_code, [code], []) ] ))
      in
      collect_big_maps ctxt storage_type init
      >>=? fun (to_duplicate, ctxt) ->
      let to_update = no_big_map_id in
      extract_big_map_diff
        ctxt
        Optimized
        storage_type
        init
        ~to_duplicate
        ~to_update
        ~temporary:true
      >>=? fun (init, big_map_diff, ctxt) ->
      unparse_data ctxt Optimized storage_type init
      >>=? fun (storage, ctxt) ->
      let storage = Script.lazy_expr @@ Micheline.strip_locations storage in
      ( if spendable then
        Legacy_support.add_do
          ~manager_pkh:manager
          ~script_code:code
          ~script_storage:storage
      else if delegatable then
        Legacy_support.add_set_delegate
          ~manager_pkh:manager
          ~script_code:code
          ~script_storage:storage
      else if Legacy_support.has_default_entrypoint code then
        Legacy_support.add_root_entrypoint code
        >>=? fun code -> return (code, storage)
      else return (code, storage) )
      >>=? fun (code, storage) ->
      Contract.fresh_contract_from_current_nonce ctxt
      >>=? fun (ctxt, contract) ->
      let operation =
        Origination
          {
            credit;
            delegate;
            preorigination = Some contract;
            script = {code; storage};
          }
      in
      Lwt.return (fresh_internal_nonce ctxt)
      >>=? fun (ctxt, nonce) ->
      logged_return
        ( Item
            ( ( Internal_operation
                  {source = step_constants.self; operation; nonce},
                big_map_diff ),
              Item ((contract, "default"), rest) ),
          ctxt )
  | ( Create_contract_2 (storage_type, param_type, Lam (_, code), root_name),
      (* Removed the instruction's arguments manager, spendable and delegatable *)
    Item (delegate, Item (credit, Item (init, rest))) ) ->
      Lwt.return (Gas.consume ctxt Interp_costs.create_contract)
      >>=? fun ctxt ->
      unparse_ty ctxt param_type
      >>=? fun (unparsed_param_type, ctxt) ->
      let unparsed_param_type =
        Script_ir_translator.add_field_annot
          (Option.map ~f:(fun n -> `Field_annot n) root_name)
          None
          unparsed_param_type
      in
      unparse_ty ctxt storage_type
      >>=? fun (unparsed_storage_type, ctxt) ->
      let code =
        Micheline.strip_locations
          (Seq
             ( 0,
               [ Prim (0, K_parameter, [unparsed_param_type], []);
                 Prim (0, K_storage, [unparsed_storage_type], []);
                 Prim (0, K_code, [code], []) ] ))
      in
      collect_big_maps ctxt storage_type init
      >>=? fun (to_duplicate, ctxt) ->
      let to_update = no_big_map_id in
      extract_big_map_diff
        ctxt
        Optimized
        storage_type
        init
        ~to_duplicate
        ~to_update
        ~temporary:true
      >>=? fun (init, big_map_diff, ctxt) ->
      unparse_data ctxt Optimized storage_type init
      >>=? fun (storage, ctxt) ->
      let storage = Micheline.strip_locations storage in
      Contract.fresh_contract_from_current_nonce ctxt
      >>=? fun (ctxt, contract) ->
      let operation =
        Origination
          {
            credit;
            delegate;
            preorigination = Some contract;
            script =
              {
                code = Script.lazy_expr code;
                storage = Script.lazy_expr storage;
              };
          }
      in
      Lwt.return (fresh_internal_nonce ctxt)
      >>=? fun (ctxt, nonce) ->
      logged_return
        ( Item
            ( ( Internal_operation
                  {source = step_constants.self; operation; nonce},
                big_map_diff ),
              Item ((contract, "default"), rest) ),
          ctxt )
  | (Set_delegate, Item (delegate, rest)) ->
      Lwt.return (Gas.consume ctxt Interp_costs.create_account)
      >>=? fun ctxt ->
      let operation = Delegation delegate in
      Lwt.return (fresh_internal_nonce ctxt)
      >>=? fun (ctxt, nonce) ->
      logged_return
        ( Item
            ( ( Internal_operation
                  {source = step_constants.self; operation; nonce},
                None ),
              rest ),
          ctxt )
  | (Balance, rest) ->
      Lwt.return (Gas.consume ctxt Interp_costs.balance)
      >>=? fun ctxt ->
      Contract.get_balance ctxt step_constants.self
      >>=? fun balance -> logged_return (Item (balance, rest), ctxt)
  | (Now, rest) ->
      Lwt.return (Gas.consume ctxt Interp_costs.now)
      >>=? fun ctxt ->
      let now = Script_timestamp.now ctxt in
      logged_return (Item (now, rest), ctxt)
  | (Check_signature, Item (key, Item (signature, Item (message, rest)))) ->
      Lwt.return (Gas.consume ctxt (Interp_costs.check_signature key message))
      >>=? fun ctxt ->
      let res = Signature.check key signature message in
      logged_return (Item (res, rest), ctxt)
  | (Hash_key, Item (key, rest)) ->
      Lwt.return (Gas.consume ctxt Interp_costs.hash_key)
      >>=? fun ctxt ->
      logged_return (Item (Signature.Public_key.hash key, rest), ctxt)
  | (Blake2b, Item (bytes, rest)) ->
      Lwt.return (Gas.consume ctxt (Interp_costs.hash_blake2b bytes))
      >>=? fun ctxt ->
      let hash = Raw_hashes.blake2b bytes in
      logged_return (Item (hash, rest), ctxt)
  | (Sha256, Item (bytes, rest)) ->
      Lwt.return (Gas.consume ctxt (Interp_costs.hash_sha256 bytes))
      >>=? fun ctxt ->
      let hash = Raw_hashes.sha256 bytes in
      logged_return (Item (hash, rest), ctxt)
  | (Sha512, Item (bytes, rest)) ->
      Lwt.return (Gas.consume ctxt (Interp_costs.hash_sha512 bytes))
      >>=? fun ctxt ->
      let hash = Raw_hashes.sha512 bytes in
      logged_return (Item (hash, rest), ctxt)
  | (Steps_to_quota, rest) ->
      Lwt.return (Gas.consume ctxt Interp_costs.steps_to_quota)
      >>=? fun ctxt ->
      let steps =
        match Gas.level ctxt with
        | Limited {remaining} ->
            remaining
        | Unaccounted ->
            Z.of_string "99999999"
      in
      logged_return (Item (Script_int.(abs (of_zint steps)), rest), ctxt)
  | (Source, rest) ->
      Lwt.return (Gas.consume ctxt Interp_costs.source)
      >>=? fun ctxt ->
      logged_return (Item ((step_constants.payer, "default"), rest), ctxt)
  | (Sender, rest) ->
      Lwt.return (Gas.consume ctxt Interp_costs.source)
      >>=? fun ctxt ->
      logged_return (Item ((step_constants.source, "default"), rest), ctxt)
  | (Self (t, entrypoint), rest) ->
      Lwt.return (Gas.consume ctxt Interp_costs.self)
      >>=? fun ctxt ->
      logged_return (Item ((t, (step_constants.self, entrypoint)), rest), ctxt)
  | (Amount, rest) ->
      Lwt.return (Gas.consume ctxt Interp_costs.amount)
      >>=? fun ctxt -> logged_return (Item (step_constants.amount, rest), ctxt)
  | (Dig (n, n'), stack) ->
      Lwt.return (Gas.consume ctxt (Interp_costs.stack_n_op n))
      >>=? fun ctxt ->
      interp_stack_prefix_preserving_operation
        (fun (Item (v, rest)) -> return (rest, v))
        n'
        stack
      >>=? fun (aft, x) -> logged_return (Item (x, aft), ctxt)
  | (Dug (n, n'), Item (v, rest)) ->
      Lwt.return (Gas.consume ctxt (Interp_costs.stack_n_op n))
      >>=? fun ctxt ->
      interp_stack_prefix_preserving_operation
        (fun stk -> return (Item (v, stk), ()))
        n'
        rest
      >>=? fun (aft, ()) -> logged_return (aft, ctxt)
  | (Dipn (n, n', b), stack) ->
      Lwt.return (Gas.consume ctxt (Interp_costs.stack_n_op n))
      >>=? fun ctxt ->
      interp_stack_prefix_preserving_operation
        (fun stk ->
          step ?log ctxt step_constants b stk
          >>=? fun (res, ctxt') -> return (res, ctxt'))
        n'
        stack
      >>=? fun (aft, ctxt') -> logged_return (aft, ctxt')
  | (Dropn (n, n'), stack) ->
      Lwt.return (Gas.consume ctxt (Interp_costs.stack_n_op n))
      >>=? fun ctxt ->
      interp_stack_prefix_preserving_operation
        (fun stk -> return (stk, stk))
        n'
        stack
      >>=? fun (_, rest) -> logged_return (rest, ctxt)
  | (ChainId, rest) ->
      Lwt.return (Gas.consume ctxt Interp_costs.chain_id)
      >>=? fun ctxt ->
      logged_return (Item (step_constants.chain_id, rest), ctxt)

and interp :
    type p r.
    ?log:execution_trace ref ->
    context ->
    step_constants ->
    (p, r) lambda ->
    p ->
    (r * context) tzresult Lwt.t =
 fun ?log ctxt step_constants (Lam (code, _)) arg ->
  let stack = Item (arg, Empty) in
  ( match log with
  | None ->
      return_unit
  | Some log ->
      trace Cannot_serialize_log (unparse_stack ctxt (stack, code.bef))
      >>=? fun stack ->
      log := (code.loc, Gas.level ctxt, stack) :: !log ;
      return_unit )
  >>=? fun () ->
  step ?log ctxt step_constants code stack
  >>=? fun (Item (ret, Empty), ctxt) -> return (ret, ctxt)

(* ---- contract handling ---------------------------------------------------*)
and execute ?log ctxt mode step_constants ~entrypoint unparsed_script arg :
    ( Script.expr
    * packed_internal_operation list
    * context
    * Contract.big_map_diff option )
    tzresult
    Lwt.t =
  parse_script ctxt unparsed_script ~legacy:true
  >>=? fun (Ex_script {code; arg_type; storage; storage_type; root_name}, ctxt) ->
  trace
    (Bad_contract_parameter step_constants.self)
    (Lwt.return (find_entrypoint arg_type ~root_name entrypoint))
  >>=? fun (box, _) ->
  trace
    (Bad_contract_parameter step_constants.self)
    (parse_data ctxt ~legacy:false arg_type (box arg))
  >>=? fun (arg, ctxt) ->
  Script.force_decode ctxt unparsed_script.code
  >>=? fun (script_code, ctxt) ->
  Script_ir_translator.collect_big_maps ctxt arg_type arg
  >>=? fun (to_duplicate, ctxt) ->
  Script_ir_translator.collect_big_maps ctxt storage_type storage
  >>=? fun (to_update, ctxt) ->
  trace
    (Runtime_contract_error (step_constants.self, script_code))
    (interp ?log ctxt step_constants code (arg, storage))
  >>=? fun ((ops, storage), ctxt) ->
  Script_ir_translator.extract_big_map_diff
    ctxt
    mode
    ~temporary:false
    ~to_duplicate
    ~to_update
    storage_type
    storage
  >>=? fun (storage, big_map_diff, ctxt) ->
  trace Cannot_serialize_storage (unparse_data ctxt mode storage_type storage)
  >>=? fun (storage, ctxt) ->
  let (ops, op_diffs) = List.split ops in
  let big_map_diff =
    match
      List.flatten
        (List.map (Option.unopt ~default:[]) (op_diffs @ [big_map_diff]))
    with
    | [] ->
        None
    | diff ->
        Some diff
  in
  return (Micheline.strip_locations storage, ops, ctxt, big_map_diff)

type execution_result = {
  ctxt : context;
  storage : Script.expr;
  big_map_diff : Contract.big_map_diff option;
  operations : packed_internal_operation list;
}

let trace ctxt mode step_constants ~script ~entrypoint ~parameter =
  let log = ref [] in
  execute
    ~log
    ctxt
    mode
    step_constants
    ~entrypoint
    script
    (Micheline.root parameter)
  >>=? fun (storage, operations, ctxt, big_map_diff) ->
  let trace = List.rev !log in
  return ({ctxt; storage; big_map_diff; operations}, trace)

let execute ctxt mode step_constants ~script ~entrypoint ~parameter =
  execute
    ctxt
    mode
    step_constants
    ~entrypoint
    script
    (Micheline.root parameter)
  >>=? fun (storage, operations, ctxt, big_map_diff) ->
  return {ctxt; storage; big_map_diff; operations}

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Import Alpha_context.

Import Script.

Import Script_typed_ir.

Import Script_ir_translator.

Definition execution_trace :=
  list
    (Tezos_raw_protocol_alpha.Alpha_context.Script.location *
      Tezos_raw_protocol_alpha.Alpha_context.Gas.t *
      list (Tezos_raw_protocol_alpha.Alpha_context.Script.expr * option string)).

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Top-level evaluations are considered as an error as sources of side-effects *)
Compute
  let trace_encoding :=
    op_atat
      (let arg := __list_value in
      fun eta => arg None eta)
      (obj3 (req None None "location" % string Script.location_encoding)
        (req None None "gas" % string Gas.encoding)
        (req None None "stack" % string
          (__list_value None
            (obj2 (req None None "item" % string Script.expr_encoding)
              (opt None None "annot" % string __string_value))))) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.script_rejected" % string "Script failed" % string
      "A FAILWITH instruction was reached" % string None
      (obj3 (req None None "location" % string Script.location_encoding)
        (req None None "with" % string Script.expr_encoding)
        (opt None None "trace" % string trace_encoding))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Reject loc v
            trace => Some (loc, v, trace)
        | _ => None
        end)
      (fun function_parameter =>
        let '(loc, v, trace) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Reject loc v
          trace) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.script_overflow" % string
      "Script failed (overflow error)" % string
      "A FAIL instruction was reached due to the detection of an overflow" %
        string None
      (obj2 (req None None "location" % string Script.location_encoding)
        (opt None None "trace" % string trace_encoding))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Overflow loc
            trace => Some (loc, trace)
        | _ => None
        end)
      (fun function_parameter =>
        let '(loc, trace) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Overflow loc
          trace) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.runtime_error" % string
      "Script runtime error" % string
      "Toplevel error for all runtime script errors" % string None
      (obj2 (req None None "contract_handle" % string Contract.encoding)
        (req None None "contract_code" % string Script.expr_encoding))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Runtime_contract_error
            contract expr => Some (contract, expr)
        | _ => None
        end)
      (fun function_parameter =>
        let '(contract, expr) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Runtime_contract_error
          contract expr) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.bad_contract_parameter" % string
      "Contract supplied an invalid parameter" % string
      "Either no parameter was supplied to a contract with a non-unit parameter type, a non-unit parameter was passed to an account, or a parameter was supplied of the wrong type"
        % string None
      (obj1 (req None None "contract" % string Contract.encoding))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Bad_contract_parameter
            c => Some c
        | _ => None
        end)
      (fun c =>
        Tezos_protocol_environment_alpha__Environment.Error_monad.Bad_contract_parameter
          c) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.cannot_serialize_log" % string
      "Not enough gas to serialize execution trace" % string
      "Execution trace with stacks was to big to be serialized with the provided gas"
        % string None Data_encoding.empty
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Cannot_serialize_log
          => Some tt
        | _ => None
        end)
      (fun function_parameter =>
        let 'tt := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Cannot_serialize_log)
    in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.cannot_serialize_failure" % string
      "Not enough gas to serialize argument of FAILWITH" % string
      "Argument of FAILWITH was too big to be serialized with the provided gas"
        % string None Data_encoding.empty
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Cannot_serialize_failure
          => Some tt
        | _ => None
        end)
      (fun function_parameter =>
        let 'tt := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Cannot_serialize_failure)
    in
  register_error_kind
    (* ❌ Variants not supported *)
    variant "michelson_v1.cannot_serialize_storage" % string
    "Not enough gas to serialize execution storage" % string
    "The returned storage was too big to be serialized with the provided gas" %
      string None Data_encoding.empty
    (fun function_parameter =>
      match function_parameter with
      |
        Tezos_protocol_environment_alpha__Environment.Error_monad.Cannot_serialize_storage
        => Some tt
      | _ => None
      end)
    (fun function_parameter =>
      let 'tt := function_parameter in
      Tezos_protocol_environment_alpha__Environment.Error_monad.Cannot_serialize_storage).

Reserved Notation "'stack".

Inductive stack_gadt : Set :=
| Item : forall {ty : Set}, ty -> stack_gadt -> stack_gadt
| Empty : stack_gadt

where "'stack" := (fun (tys : Set) => stack_gadt).

Definition stack := 'stack.

Definition unparse_stack {A : Set}
  (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
  (function_parameter :
    stack A * Tezos_raw_protocol_alpha.Script_typed_ir.stack_ty A)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (list (Tezos_raw_protocol_alpha.Alpha_context.Script.expr * option string))) :=
  let '(stack, stack_ty) := function_parameter in
  let ctxt := Gas.set_unlimited ctxt in
  let fix unparse_stack {a : Set}
    (function_parameter :
    stack a * Tezos_raw_protocol_alpha.Script_typed_ir.stack_ty a)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (list
          (Tezos_raw_protocol_alpha.Alpha_context.Script.expr * option string))) :=
    match function_parameter with
    | (Empty, Tezos_raw_protocol_alpha.Script_typed_ir.Empty_t) => return_nil
    |
      (Item v rest,
        Tezos_raw_protocol_alpha.Script_typed_ir.Item_t ty rest_ty annot) =>
      op_gtgteqquestion
        (unparse_data ctxt
          Tezos_raw_protocol_alpha.Script_ir_translator.Readable ty v)
        (fun function_parameter =>
          let '(data, _ctxt) := function_parameter in
          op_gtgteqquestion (unparse_stack (rest, rest_ty))
            (fun rest =>
              let annot :=
                match Script_ir_annot.unparse_var_annot annot with
                | [] => None
                | cons a [] => Some a
                | _ =>
                  (* ❌ Assert instruction is not handled. *)
                  assert false
                end in
              let data := Micheline.strip_locations data in
              __return (cons (data, annot) rest)))
    end in
  unparse_stack (stack, stack_ty).

Module Interp_costs := Michelson_v1_gas.Cost_of.Interpreter.

Fixpoint interp_stack_prefix_preserving_operation
  {aft bef faft fbef result : Set}
  (f :
    stack fbef ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (stack faft * result)))
  (n :
    Tezos_raw_protocol_alpha.Script_typed_ir.stack_prefix_preservation_witness
      fbef faft bef aft) (stk : stack bef)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (stack aft * result)) :=
  match (n, stk) with
  |
    (Tezos_raw_protocol_alpha.Script_typed_ir.Prefix
      (Tezos_raw_protocol_alpha.Script_typed_ir.Prefix
        (Tezos_raw_protocol_alpha.Script_typed_ir.Prefix
          (Tezos_raw_protocol_alpha.Script_typed_ir.Prefix
            (Tezos_raw_protocol_alpha.Script_typed_ir.Prefix
              (Tezos_raw_protocol_alpha.Script_typed_ir.Prefix
                (Tezos_raw_protocol_alpha.Script_typed_ir.Prefix
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Prefix
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Prefix
                      (Tezos_raw_protocol_alpha.Script_typed_ir.Prefix
                        (Tezos_raw_protocol_alpha.Script_typed_ir.Prefix
                          (Tezos_raw_protocol_alpha.Script_typed_ir.Prefix
                            (Tezos_raw_protocol_alpha.Script_typed_ir.Prefix
                              (Tezos_raw_protocol_alpha.Script_typed_ir.Prefix
                                (Tezos_raw_protocol_alpha.Script_typed_ir.Prefix
                                  (Tezos_raw_protocol_alpha.Script_typed_ir.Prefix
                                    n))))))))))))))),
      Item v0
        (Item v1
          (Item v2
            (Item v3
              (Item v4
                (Item v5
                  (Item v6
                    (Item v7
                      (Item v8
                        (Item v9
                          (Item va
                            (Item vb
                              (Item vc (Item vd (Item ve (Item vf rest))))))))))))))))
    =>
    op_gtgteqquestion (interp_stack_prefix_preserving_operation f n rest)
      (fun function_parameter =>
        let '(rest', __result_value) := function_parameter in
        __return
          ((Item v0
            (Item v1
              (Item v2
                (Item v3
                  (Item v4
                    (Item v5
                      (Item v6
                        (Item v7
                          (Item v8
                            (Item v9
                              (Item va
                                (Item vb
                                  (Item vc (Item vd (Item ve (Item vf rest')))))))))))))))),
            __result_value))
  |
    (Tezos_raw_protocol_alpha.Script_typed_ir.Prefix
      (Tezos_raw_protocol_alpha.Script_typed_ir.Prefix
        (Tezos_raw_protocol_alpha.Script_typed_ir.Prefix
          (Tezos_raw_protocol_alpha.Script_typed_ir.Prefix n))),
      Item v0 (Item v1 (Item v2 (Item v3 rest)))) =>
    op_gtgteqquestion (interp_stack_prefix_preserving_operation f n rest)
      (fun function_parameter =>
        let '(rest', __result_value) := function_parameter in
        __return ((Item v0 (Item v1 (Item v2 (Item v3 rest')))), __result_value))
  | (Tezos_raw_protocol_alpha.Script_typed_ir.Prefix n, Item v rest) =>
    op_gtgteqquestion (interp_stack_prefix_preserving_operation f n rest)
      (fun function_parameter =>
        let '(rest', __result_value) := function_parameter in
        __return ((Item v rest'), __result_value))
  | (Tezos_raw_protocol_alpha.Script_typed_ir.Rest, v) => f v
  end.

Module step_constants.
  Record record := {
    source : Tezos_raw_protocol_alpha.Alpha_context.Contract.t;
    payer : Tezos_raw_protocol_alpha.Alpha_context.Contract.t;
    self : Tezos_raw_protocol_alpha.Alpha_context.Contract.t;
    amount : Tezos_raw_protocol_alpha.Alpha_context.Tez.t;
    chain_id : Tezos_protocol_environment_alpha__Environment.Chain_id.t }.
End step_constants.
Definition step_constants := step_constants.record.

Fixpoint step {a b : Set}
  (log :
    option
      (Tezos_protocol_environment_alpha__Environment.Pervasives.ref
        execution_trace))
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
  (step_constants : step_constants)
  (function_parameter : Tezos_raw_protocol_alpha.Script_typed_ir.descr b a)
  : stack b ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (stack a * Tezos_raw_protocol_alpha.Alpha_context.context)) :=
  let
    '{|
      Tezos_raw_protocol_alpha.Script_typed_ir.descr.loc := loc;
        Tezos_raw_protocol_alpha.Script_typed_ir.descr.instr := instr
        |} as __descr_value := function_parameter in
  fun stack =>
    op_gtgteqquestion (Lwt.__return (Gas.consume ctxt Interp_costs.cycle))
      (fun ctxt =>
        let logged_return
          (__descr_value : Tezos_raw_protocol_alpha.Script_typed_ir.descr b a)
          (function_parameter :
          stack a * Tezos_raw_protocol_alpha.Alpha_context.context)
          : Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
              (stack a * Tezos_raw_protocol_alpha.Alpha_context.context)) :=
          let '(ret, ctxt) := function_parameter in
          match log with
          | None => __return (ret, ctxt)
          | Some log =>
            op_gtgteqquestion
              (trace
                Tezos_protocol_environment_alpha__Environment.Error_monad.Cannot_serialize_log
                (unparse_stack ctxt
                  (ret,
                    (Tezos_raw_protocol_alpha.Script_typed_ir.descr.aft
                      __descr_value))))
              (fun stack =>
                (* ❌ Sequences of instructions are not handled (operator ";") *)
                let _ :=
                  op_coloneq log
                    (cons
                      ((Tezos_raw_protocol_alpha.Script_typed_ir.descr.loc
                        __descr_value), (Gas.level ctxt), stack)
                      (op_exclamation log)) in
                __return (ret, ctxt))
          end in
        let get_log
          (log :
          option
            (Tezos_protocol_environment_alpha__Environment.Pervasives.ref
              execution_trace))
          : option
            (list
              (Tezos_raw_protocol_alpha.Alpha_context.Script.location *
                Tezos_raw_protocol_alpha.Alpha_context.Gas.t *
                list
                  (Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
                    option string))) :=
          Option.map (fun l => List.rev (op_exclamation l)) log in
        let consume_gas_terop {C D E arg1 arg2 arg3 rest ret : Set}
          (__descr_value :
          Tezos_raw_protocol_alpha.Script_typed_ir.descr (C * (D * (E * rest)))
            (ret * rest)) (function_parameter :
          (arg1 -> arg2 -> arg3 -> ret) * arg1 * arg2 * arg3)
          : (arg1 -> arg2 -> arg3 ->
          Tezos_raw_protocol_alpha.Alpha_context.Gas.cost) -> stack rest ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
              (stack (ret * rest) *
                Tezos_raw_protocol_alpha.Alpha_context.context)) :=
          let '(op, x1, x2, x3) := function_parameter in
          fun cost_func =>
            fun rest =>
              op_gtgteqquestion
                (Lwt.__return (Gas.consume ctxt (cost_func x1 x2 x3)))
                (fun ctxt =>
                  logged_return __descr_value ((Item (op x1 x2 x3) rest), ctxt))
          in
        let consume_gas_binop {C D arg1 arg2 rest ret : Set}
          (__descr_value :
          Tezos_raw_protocol_alpha.Script_typed_ir.descr (C * (D * rest))
            (ret * rest)) (function_parameter :
          (arg1 -> arg2 -> ret) * arg1 * arg2)
          : (arg1 -> arg2 -> Tezos_raw_protocol_alpha.Alpha_context.Gas.cost) ->
          stack rest -> Tezos_raw_protocol_alpha.Alpha_context.context ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
              (stack (ret * rest) *
                Tezos_raw_protocol_alpha.Alpha_context.context)) :=
          let '(op, x1, x2) := function_parameter in
          fun cost_func =>
            fun rest =>
              fun ctxt =>
                op_gtgteqquestion
                  (Lwt.__return (Gas.consume ctxt (cost_func x1 x2)))
                  (fun ctxt =>
                    logged_return __descr_value ((Item (op x1 x2) rest), ctxt))
          in
        let consume_gas_unop {C arg rest ret : Set}
          (__descr_value :
          Tezos_raw_protocol_alpha.Script_typed_ir.descr (C * rest) (ret * rest))
          (function_parameter : (arg -> ret) * arg)
          : (arg -> Tezos_raw_protocol_alpha.Alpha_context.Gas.cost) ->
          stack rest -> Tezos_raw_protocol_alpha.Alpha_context.context ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
              (stack (ret * rest) *
                Tezos_raw_protocol_alpha.Alpha_context.context)) :=
          let '(op, arg) := function_parameter in
          fun cost_func =>
            fun rest =>
              fun ctxt =>
                op_gtgteqquestion
                  (Lwt.__return (Gas.consume ctxt (cost_func arg)))
                  (fun ctxt =>
                    logged_return __descr_value ((Item (op arg) rest), ctxt)) in
        let logged_return := logged_return __descr_value in
        match (instr, stack) with
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Drop, Item _ rest) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.stack_op))
            (fun ctxt => logged_return (rest, ctxt))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Dup, Item v rest) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.stack_op))
            (fun ctxt => logged_return ((Item v (Item v rest)), ctxt))
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Swap, Item vi (Item vo rest))
          =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.stack_op))
            (fun ctxt => logged_return ((Item vo (Item vi rest)), ctxt))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Const v, rest) =>
          op_gtgteqquestion (Lwt.__return (Gas.consume ctxt Interp_costs.push))
            (fun ctxt => logged_return ((Item v rest), ctxt))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Cons_some, Item v rest) =>
          op_gtgteqquestion (Lwt.__return (Gas.consume ctxt Interp_costs.wrap))
            (fun ctxt => logged_return ((Item (Some v) rest), ctxt))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Cons_none _, rest) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.variant_no_data))
            (fun ctxt => logged_return ((Item None rest), ctxt))
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.If_none bt _, Item None rest)
          =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.branch))
            (fun ctxt => step log ctxt step_constants bt rest)
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.If_none _ bf,
            Item (Some v) rest) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.branch))
            (fun ctxt => step log ctxt step_constants bf (Item v rest))
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Cons_pair,
            Item a (Item b rest)) =>
          op_gtgteqquestion (Lwt.__return (Gas.consume ctxt Interp_costs.pair))
            (fun ctxt => logged_return ((Item (a, b) rest), ctxt))
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Seq {|
            Tezos_raw_protocol_alpha.Script_typed_ir.descr.instr :=
              Tezos_raw_protocol_alpha.Script_typed_ir.Dup
              |} {|
            Tezos_raw_protocol_alpha.Script_typed_ir.descr.instr :=
              Tezos_raw_protocol_alpha.Script_typed_ir.Seq {|
                Tezos_raw_protocol_alpha.Script_typed_ir.descr.instr :=
                  Tezos_raw_protocol_alpha.Script_typed_ir.Car
                  |} {|
                Tezos_raw_protocol_alpha.Script_typed_ir.descr.instr :=
                  Tezos_raw_protocol_alpha.Script_typed_ir.Seq
                    {|
                    Tezos_raw_protocol_alpha.Script_typed_ir.descr.instr
                      :=
                      Tezos_raw_protocol_alpha.Script_typed_ir.Dip
                        {|
                        Tezos_raw_protocol_alpha.Script_typed_ir.descr.instr
                          :=
                          Tezos_raw_protocol_alpha.Script_typed_ir.Cdr
                          |}
                      |}
                    {|
                    Tezos_raw_protocol_alpha.Script_typed_ir.descr.instr
                      :=
                      Tezos_raw_protocol_alpha.Script_typed_ir.Nop
                      |}
                  |}
              |}, Item (a, b) rest) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.pair_access))
            (fun ctxt => logged_return ((Item a (Item b rest)), ctxt))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Car, Item (a, _) rest) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.pair_access))
            (fun ctxt => logged_return ((Item a rest), ctxt))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Cdr, Item (_, b) rest) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.pair_access))
            (fun ctxt => logged_return ((Item b rest), ctxt))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Left, Item v rest) =>
          op_gtgteqquestion (Lwt.__return (Gas.consume ctxt Interp_costs.wrap))
            (fun ctxt =>
              logged_return
                ((Item (Tezos_raw_protocol_alpha.Script_typed_ir.L v) rest),
                  ctxt))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Right, Item v rest) =>
          op_gtgteqquestion (Lwt.__return (Gas.consume ctxt Interp_costs.wrap))
            (fun ctxt =>
              logged_return
                ((Item (Tezos_raw_protocol_alpha.Script_typed_ir.R v) rest),
                  ctxt))
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.If_left bt _,
            Item (Tezos_raw_protocol_alpha.Script_typed_ir.L v) rest) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.branch))
            (fun ctxt => step log ctxt step_constants bt (Item v rest))
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.If_left _ bf,
            Item (Tezos_raw_protocol_alpha.Script_typed_ir.R v) rest) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.branch))
            (fun ctxt => step log ctxt step_constants bf (Item v rest))
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Cons_list,
            Item hd (Item tl rest)) =>
          op_gtgteqquestion (Lwt.__return (Gas.consume ctxt Interp_costs.cons))
            (fun ctxt => logged_return ((Item (cons hd tl) rest), ctxt))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Nil, rest) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.variant_no_data))
            (fun ctxt => logged_return ((Item [] rest), ctxt))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.If_cons _ bf, Item [] rest)
          =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.branch))
            (fun ctxt => step log ctxt step_constants bf rest)
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.If_cons bt _,
            Item (cons hd tl) rest) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.branch))
            (fun ctxt =>
              step log ctxt step_constants bt (Item hd (Item tl rest)))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.List_map body, Item l rest)
          =>
          let fix loop
            (rest : stack op_dollar49) (ctxt :
            Tezos_raw_protocol_alpha__Alpha_context.context) (l :
            list op_dollar48) (acc : list op_dollar50)
            : Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
                (stack (list op_dollar50 * op_dollar49) *
                  Tezos_raw_protocol_alpha__Alpha_context.context)) :=
            op_gtgteqquestion
              (Lwt.__return (Gas.consume ctxt Interp_costs.loop_map))
              (fun ctxt =>
                match l with
                | [] => __return ((Item (List.rev acc) rest), ctxt)
                | cons hd tl =>
                  op_gtgteqquestion
                    (step log ctxt step_constants body (Item hd rest))
                    (fun function_parameter =>
                      let '(Item hd rest, ctxt) := function_parameter in
                      loop rest ctxt tl (cons hd acc))
                end) in
          op_gtgteqquestion (loop rest ctxt l [])
            (fun function_parameter =>
              let '(res, ctxt) := function_parameter in
              logged_return (res, ctxt))
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.List_size,
            Item __list_value rest) =>
          op_gtgteqquestion
            (Lwt.__return
              (List.fold_left
                (fun acc =>
                  fun function_parameter =>
                    let '_ := function_parameter in
                    op_gtgtquestion acc
                      (fun function_parameter =>
                        let '(size, ctxt) := function_parameter in
                        op_gtgtquestion
                          (Gas.consume ctxt Interp_costs.loop_size)
                          (fun ctxt => ok ((op_plus size 1), ctxt))))
                (ok (0, ctxt)) __list_value))
            (fun function_parameter =>
              let '(len, ctxt) := function_parameter in
              logged_return ((Item (abs (of_int len)) rest), ctxt))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.List_iter body, Item l init)
          =>
          let fix loop
            (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context) (l :
            list op_dollar53) (stack : stack op_dollar54)
            : Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
                (stack op_dollar54 *
                  Tezos_raw_protocol_alpha__Alpha_context.context)) :=
            op_gtgteqquestion
              (Lwt.__return (Gas.consume ctxt Interp_costs.loop_iter))
              (fun ctxt =>
                match l with
                | [] => __return (stack, ctxt)
                | cons hd tl =>
                  op_gtgteqquestion
                    (step log ctxt step_constants body (Item hd stack))
                    (fun function_parameter =>
                      let '(stack, ctxt) := function_parameter in
                      loop ctxt tl stack)
                end) in
          op_gtgteqquestion (loop ctxt l init)
            (fun function_parameter =>
              let '(res, ctxt) := function_parameter in
              logged_return (res, ctxt))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Empty_set t, rest) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.empty_set))
            (fun ctxt => logged_return ((Item (empty_set t) rest), ctxt))
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Set_iter body, Item set init)
          =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt (Interp_costs.set_to_list set)))
            (fun ctxt =>
              let l :=
                List.rev (set_fold (fun e => fun acc => cons e acc) set []) in
              let fix loop
                (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context) (l :
                list op_dollar56) (stack : stack op_dollar57)
                : Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
                    (stack op_dollar57 *
                      Tezos_raw_protocol_alpha__Alpha_context.context)) :=
                op_gtgteqquestion
                  (Lwt.__return (Gas.consume ctxt Interp_costs.loop_iter))
                  (fun ctxt =>
                    match l with
                    | [] => __return (stack, ctxt)
                    | cons hd tl =>
                      op_gtgteqquestion
                        (step log ctxt step_constants body (Item hd stack))
                        (fun function_parameter =>
                          let '(stack, ctxt) := function_parameter in
                          loop ctxt tl stack)
                    end) in
              op_gtgteqquestion (loop ctxt l init)
                (fun function_parameter =>
                  let '(res, ctxt) := function_parameter in
                  logged_return (res, ctxt)))
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Set_mem,
            Item v (Item set rest)) =>
          consume_gas_binop __descr_value (set_mem, v, set) Interp_costs.set_mem
            rest ctxt
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Set_update,
            Item v (Item presence (Item set rest))) =>
          consume_gas_terop __descr_value (set_update, v, presence, set)
            Interp_costs.set_update rest
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Set_size, Item set rest) =>
          consume_gas_unop __descr_value (set_size, set)
            (fun function_parameter =>
              let '_ := function_parameter in
              Interp_costs.set_size) rest ctxt
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Empty_map t _, rest) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.empty_map))
            (fun ctxt => logged_return ((Item (empty_map t) rest), ctxt))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Map_map body, Item map rest)
          =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt (Interp_costs.map_to_list map)))
            (fun ctxt =>
              let l :=
                List.rev
                  (map_fold (fun k => fun v => fun acc => cons (k, v) acc) map
                    []) in
              let fix loop
                (rest : stack op_dollar68) (ctxt :
                Tezos_raw_protocol_alpha__Alpha_context.context) (l :
                list (op_dollar66 * op_dollar67)) (acc :
                Tezos_raw_protocol_alpha.Script_typed_ir.map op_dollar66
                  op_dollar69)
                : Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
                    (Tezos_raw_protocol_alpha.Script_typed_ir.map op_dollar66
                      op_dollar69 *
                      Tezos_raw_protocol_alpha__Alpha_context.context)) :=
                op_gtgteqquestion
                  (Lwt.__return (Gas.consume ctxt Interp_costs.loop_map))
                  (fun ctxt =>
                    match l with
                    | [] => __return (acc, ctxt)
                    | cons ((k, _) as hd) tl =>
                      op_gtgteqquestion
                        (step log ctxt step_constants body (Item hd rest))
                        (fun function_parameter =>
                          let '(Item hd rest, ctxt) := function_parameter in
                          loop rest ctxt tl (map_update k (Some hd) acc))
                    end) in
              op_gtgteqquestion (loop rest ctxt l (empty_map (map_key_ty map)))
                (fun function_parameter =>
                  let '(res, ctxt) := function_parameter in
                  logged_return ((Item res rest), ctxt)))
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Map_iter body, Item map init)
          =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt (Interp_costs.map_to_list map)))
            (fun ctxt =>
              let l :=
                List.rev
                  (map_fold (fun k => fun v => fun acc => cons (k, v) acc) map
                    []) in
              let fix loop
                (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context) (l :
                list (op_dollar70 * op_dollar71)) (stack : stack op_dollar72)
                : Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
                    (stack op_dollar72 *
                      Tezos_raw_protocol_alpha__Alpha_context.context)) :=
                op_gtgteqquestion
                  (Lwt.__return (Gas.consume ctxt Interp_costs.loop_iter))
                  (fun ctxt =>
                    match l with
                    | [] => __return (stack, ctxt)
                    | cons hd tl =>
                      op_gtgteqquestion
                        (step log ctxt step_constants body (Item hd stack))
                        (fun function_parameter =>
                          let '(stack, ctxt) := function_parameter in
                          loop ctxt tl stack)
                    end) in
              op_gtgteqquestion (loop ctxt l init)
                (fun function_parameter =>
                  let '(res, ctxt) := function_parameter in
                  logged_return (res, ctxt)))
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Map_mem,
            Item v (Item map rest)) =>
          consume_gas_binop __descr_value (map_mem, v, map) Interp_costs.map_mem
            rest ctxt
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Map_get,
            Item v (Item map rest)) =>
          consume_gas_binop __descr_value (map_get, v, map) Interp_costs.map_get
            rest ctxt
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Map_update,
            Item k (Item v (Item map rest))) =>
          consume_gas_terop __descr_value (map_update, k, v, map)
            Interp_costs.map_update rest
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Map_size, Item map rest) =>
          consume_gas_unop __descr_value (map_size, map)
            (fun function_parameter =>
              let '_ := function_parameter in
              Interp_costs.map_size) rest ctxt
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Empty_big_map tk tv, rest)
          =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.empty_map))
            (fun ctxt =>
              logged_return
                ((Item (Script_ir_translator.empty_big_map tk tv) rest), ctxt))
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Big_map_mem,
            Item key (Item map rest)) =>
          op_gtgteqquestion
            (Lwt.__return
              (Gas.consume ctxt
                (Interp_costs.map_mem key
                  (Tezos_raw_protocol_alpha.Script_typed_ir.big_map.diff map))))
            (fun ctxt =>
              op_gtgteqquestion (Script_ir_translator.big_map_mem ctxt key map)
                (fun function_parameter =>
                  let '(res, ctxt) := function_parameter in
                  logged_return ((Item res rest), ctxt)))
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Big_map_get,
            Item key (Item map rest)) =>
          op_gtgteqquestion
            (Lwt.__return
              (Gas.consume ctxt
                (Interp_costs.map_get key
                  (Tezos_raw_protocol_alpha.Script_typed_ir.big_map.diff map))))
            (fun ctxt =>
              op_gtgteqquestion (Script_ir_translator.big_map_get ctxt key map)
                (fun function_parameter =>
                  let '(res, ctxt) := function_parameter in
                  logged_return ((Item res rest), ctxt)))
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Big_map_update,
            Item key (Item maybe_value (Item map rest))) =>
          consume_gas_terop __descr_value
            (Script_ir_translator.big_map_update, key, maybe_value, map)
            (fun k =>
              fun v =>
                fun m =>
                  Interp_costs.map_update k (Some v)
                    (Tezos_raw_protocol_alpha.Script_typed_ir.big_map.diff m))
            rest
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Add_seconds_to_timestamp,
            Item n (Item t rest)) =>
          consume_gas_binop __descr_value (Script_timestamp.add_delta, t, n)
            Interp_costs.add_timestamp rest ctxt
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Add_timestamp_to_seconds,
            Item t (Item n rest)) =>
          consume_gas_binop __descr_value (Script_timestamp.add_delta, t, n)
            Interp_costs.add_timestamp rest ctxt
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Sub_timestamp_seconds,
            Item t (Item s rest)) =>
          consume_gas_binop __descr_value (Script_timestamp.sub_delta, t, s)
            Interp_costs.sub_timestamp rest ctxt
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Diff_timestamps,
            Item t1 (Item t2 rest)) =>
          consume_gas_binop __descr_value (Script_timestamp.diff, t1, t2)
            Interp_costs.diff_timestamps rest ctxt
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Concat_string_pair,
            Item x (Item y rest)) =>
          op_gtgteqquestion
            (Lwt.__return
              (Gas.consume ctxt
                (Interp_costs.concat_string (cons x (cons y [])))))
            (fun ctxt =>
              let s := String.concat "" % string (cons x (cons y [])) in
              logged_return ((Item s rest), ctxt))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Concat_string, Item ss rest)
          =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt (Interp_costs.concat_string ss)))
            (fun ctxt =>
              let s := String.concat "" % string ss in
              logged_return ((Item s rest), ctxt))
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Slice_string,
            Item offset (Item length (Item s rest))) =>
          let s_length := Z.of_int (String.length s) in
          let offset := Script_int.to_zint offset in
          let length := Script_int.to_zint length in
          if
            op_andand (op_lt offset s_length)
              (op_lteq (Z.add offset length) s_length) then
            op_gtgteqquestion
              (Lwt.__return
                (Gas.consume ctxt (Interp_costs.slice_string (Z.to_int length))))
              (fun ctxt =>
                logged_return
                  ((Item
                    (Some (String.sub s (Z.to_int offset) (Z.to_int length)))
                    rest), ctxt))
          else
            op_gtgteqquestion
              (Lwt.__return (Gas.consume ctxt (Interp_costs.slice_string 0)))
              (fun ctxt => logged_return ((Item None rest), ctxt))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.String_size, Item s rest) =>
          op_gtgteqquestion (Lwt.__return (Gas.consume ctxt Interp_costs.push))
            (fun ctxt =>
              logged_return ((Item (abs (of_int (String.length s))) rest), ctxt))
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Concat_bytes_pair,
            Item x (Item y rest)) =>
          op_gtgteqquestion
            (Lwt.__return
              (Gas.consume ctxt (Interp_costs.concat_bytes (cons x (cons y [])))))
            (fun ctxt =>
              let s := MBytes.concat "" % string (cons x (cons y [])) in
              logged_return ((Item s rest), ctxt))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Concat_bytes, Item ss rest)
          =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt (Interp_costs.concat_bytes ss)))
            (fun ctxt =>
              let s := MBytes.concat "" % string ss in
              logged_return ((Item s rest), ctxt))
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Slice_bytes,
            Item offset (Item length (Item s rest))) =>
          let s_length := Z.of_int (MBytes.length s) in
          let offset := Script_int.to_zint offset in
          let length := Script_int.to_zint length in
          if
            op_andand (op_lt offset s_length)
              (op_lteq (Z.add offset length) s_length) then
            op_gtgteqquestion
              (Lwt.__return
                (Gas.consume ctxt (Interp_costs.slice_string (Z.to_int length))))
              (fun ctxt =>
                logged_return
                  ((Item
                    (Some (MBytes.sub s (Z.to_int offset) (Z.to_int length)))
                    rest), ctxt))
          else
            op_gtgteqquestion
              (Lwt.__return (Gas.consume ctxt (Interp_costs.slice_string 0)))
              (fun ctxt => logged_return ((Item None rest), ctxt))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_size, Item s rest) =>
          op_gtgteqquestion (Lwt.__return (Gas.consume ctxt Interp_costs.push))
            (fun ctxt =>
              logged_return ((Item (abs (of_int (MBytes.length s))) rest), ctxt))
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Add_tez,
            Item x (Item y rest)) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.int64_op))
            (fun ctxt =>
              op_gtgteqquestion (Lwt.__return (op_plusquestion x y))
                (fun res => logged_return ((Item res rest), ctxt)))
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Sub_tez,
            Item x (Item y rest)) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.int64_op))
            (fun ctxt =>
              op_gtgteqquestion (Lwt.__return (op_minusquestion x y))
                (fun res => logged_return ((Item res rest), ctxt)))
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Mul_teznat,
            Item x (Item y rest)) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.int64_op))
            (fun ctxt =>
              op_gtgteqquestion
                (Lwt.__return (Gas.consume ctxt Interp_costs.z_to_int64))
                (fun ctxt =>
                  match Script_int.to_int64 y with
                  | None =>
                    fail
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.Overflow
                        loc (get_log log))
                  | Some y =>
                    op_gtgteqquestion (Lwt.__return (op_starquestion x y))
                      (fun res => logged_return ((Item res rest), ctxt))
                  end))
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Mul_nattez,
            Item y (Item x rest)) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.int64_op))
            (fun ctxt =>
              op_gtgteqquestion
                (Lwt.__return (Gas.consume ctxt Interp_costs.z_to_int64))
                (fun ctxt =>
                  match Script_int.to_int64 y with
                  | None =>
                    fail
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.Overflow
                        loc (get_log log))
                  | Some y =>
                    op_gtgteqquestion (Lwt.__return (op_starquestion x y))
                      (fun res => logged_return ((Item res rest), ctxt))
                  end))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Or, Item x (Item y rest)) =>
          consume_gas_binop __descr_value (op_pipepipe, x, y)
            Interp_costs.bool_binop rest ctxt
        | (Tezos_raw_protocol_alpha.Script_typed_ir.And, Item x (Item y rest))
          =>
          consume_gas_binop __descr_value (op_andand, x, y)
            Interp_costs.bool_binop rest ctxt
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Xor, Item x (Item y rest))
          =>
          consume_gas_binop __descr_value (Compare.Bool.op_ltgt, x, y)
            Interp_costs.bool_binop rest ctxt
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Not, Item x rest) =>
          consume_gas_unop __descr_value (not, x) Interp_costs.bool_unop rest
            ctxt
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Is_nat, Item x rest) =>
          consume_gas_unop __descr_value (Script_int.is_nat, x) Interp_costs.abs
            rest ctxt
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Abs_int, Item x rest) =>
          consume_gas_unop __descr_value (Script_int.abs, x) Interp_costs.abs
            rest ctxt
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Int_nat, Item x rest) =>
          consume_gas_unop __descr_value (Script_int.int, x) Interp_costs.int
            rest ctxt
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Neg_int, Item x rest) =>
          consume_gas_unop __descr_value (Script_int.neg, x) Interp_costs.neg
            rest ctxt
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Neg_nat, Item x rest) =>
          consume_gas_unop __descr_value (Script_int.neg, x) Interp_costs.neg
            rest ctxt
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Add_intint,
            Item x (Item y rest)) =>
          consume_gas_binop __descr_value (Script_int.add, x, y)
            Interp_costs.add rest ctxt
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Add_intnat,
            Item x (Item y rest)) =>
          consume_gas_binop __descr_value (Script_int.add, x, y)
            Interp_costs.add rest ctxt
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Add_natint,
            Item x (Item y rest)) =>
          consume_gas_binop __descr_value (Script_int.add, x, y)
            Interp_costs.add rest ctxt
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Add_natnat,
            Item x (Item y rest)) =>
          consume_gas_binop __descr_value (Script_int.add_n, x, y)
            Interp_costs.add rest ctxt
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Sub_int,
            Item x (Item y rest)) =>
          consume_gas_binop __descr_value (Script_int.sub, x, y)
            Interp_costs.sub rest ctxt
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Mul_intint,
            Item x (Item y rest)) =>
          consume_gas_binop __descr_value (Script_int.mul, x, y)
            Interp_costs.mul rest ctxt
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Mul_intnat,
            Item x (Item y rest)) =>
          consume_gas_binop __descr_value (Script_int.mul, x, y)
            Interp_costs.mul rest ctxt
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Mul_natint,
            Item x (Item y rest)) =>
          consume_gas_binop __descr_value (Script_int.mul, x, y)
            Interp_costs.mul rest ctxt
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Mul_natnat,
            Item x (Item y rest)) =>
          consume_gas_binop __descr_value (Script_int.mul_n, x, y)
            Interp_costs.mul rest ctxt
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Ediv_teznat,
            Item x (Item y rest)) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.int64_to_z))
            (fun ctxt =>
              let x := Script_int.of_int64 (Tez.to_mutez x) in
              consume_gas_binop __descr_value
                ((fun x =>
                  fun y =>
                    match Script_int.ediv x y with
                    | None => None
                    | Some (q, r) =>
                      match ((Script_int.to_int64 q), (Script_int.to_int64 r))
                        with
                      | (Some q, Some r) =>
                        match ((Tez.of_mutez q), (Tez.of_mutez r)) with
                        | (Some q, Some r) => Some (q, r)
                        | _ =>
                          (* ❌ Assert instruction is not handled. *)
                          assert false
                        end
                      | _ =>
                        (* ❌ Assert instruction is not handled. *)
                        assert false
                      end
                    end), x, y) Interp_costs.div rest ctxt)
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Ediv_tez,
            Item x (Item y rest)) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.int64_to_z))
            (fun ctxt =>
              op_gtgteqquestion
                (Lwt.__return (Gas.consume ctxt Interp_costs.int64_to_z))
                (fun ctxt =>
                  let x := Script_int.abs (Script_int.of_int64 (Tez.to_mutez x))
                    in
                  let y := Script_int.abs (Script_int.of_int64 (Tez.to_mutez y))
                    in
                  consume_gas_binop __descr_value
                    ((fun x =>
                      fun y =>
                        match Script_int.ediv_n x y with
                        | None => None
                        | Some (q, r) =>
                          match Script_int.to_int64 r with
                          | None =>
                            (* ❌ Assert instruction is not handled. *)
                            assert false
                          | Some r =>
                            match Tez.of_mutez r with
                            | None =>
                              (* ❌ Assert instruction is not handled. *)
                              assert false
                            | Some r => Some (q, r)
                            end
                          end
                        end), x, y) Interp_costs.div rest ctxt))
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Ediv_intint,
            Item x (Item y rest)) =>
          consume_gas_binop __descr_value (Script_int.ediv, x, y)
            Interp_costs.div rest ctxt
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Ediv_intnat,
            Item x (Item y rest)) =>
          consume_gas_binop __descr_value (Script_int.ediv, x, y)
            Interp_costs.div rest ctxt
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Ediv_natint,
            Item x (Item y rest)) =>
          consume_gas_binop __descr_value (Script_int.ediv, x, y)
            Interp_costs.div rest ctxt
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Ediv_natnat,
            Item x (Item y rest)) =>
          consume_gas_binop __descr_value (Script_int.ediv_n, x, y)
            Interp_costs.div rest ctxt
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Lsl_nat,
            Item x (Item y rest)) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt (Interp_costs.shift_left x y)))
            (fun ctxt =>
              match Script_int.shift_left_n x y with
              | None =>
                fail
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.Overflow
                    loc (get_log log))
              | Some x => logged_return ((Item x rest), ctxt)
              end)
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Lsr_nat,
            Item x (Item y rest)) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt (Interp_costs.shift_right x y)))
            (fun ctxt =>
              match Script_int.shift_right_n x y with
              | None =>
                fail
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.Overflow
                    loc (get_log log))
              | Some r => logged_return ((Item r rest), ctxt)
              end)
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Or_nat, Item x (Item y rest))
          =>
          consume_gas_binop __descr_value (Script_int.logor, x, y)
            Interp_costs.logor rest ctxt
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.And_nat,
            Item x (Item y rest)) =>
          consume_gas_binop __descr_value (Script_int.logand, x, y)
            Interp_costs.logand rest ctxt
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.And_int_nat,
            Item x (Item y rest)) =>
          consume_gas_binop __descr_value (Script_int.logand, x, y)
            Interp_costs.logand rest ctxt
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Xor_nat,
            Item x (Item y rest)) =>
          consume_gas_binop __descr_value (Script_int.logxor, x, y)
            Interp_costs.logxor rest ctxt
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Not_int, Item x rest) =>
          consume_gas_unop __descr_value (Script_int.lognot, x)
            Interp_costs.lognot rest ctxt
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Not_nat, Item x rest) =>
          consume_gas_unop __descr_value (Script_int.lognot, x)
            Interp_costs.lognot rest ctxt
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Seq hd tl, stack) =>
          op_gtgteqquestion (step log ctxt step_constants hd stack)
            (fun function_parameter =>
              let '(trans, ctxt) := function_parameter in
              step log ctxt step_constants tl trans)
        | (Tezos_raw_protocol_alpha.Script_typed_ir.If bt _, Item true rest) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.branch))
            (fun ctxt => step log ctxt step_constants bt rest)
        | (Tezos_raw_protocol_alpha.Script_typed_ir.If _ bf, Item false rest) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.branch))
            (fun ctxt => step log ctxt step_constants bf rest)
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Loop body, Item true rest)
          =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.loop_cycle))
            (fun ctxt =>
              op_gtgteqquestion (step log ctxt step_constants body rest)
                (fun function_parameter =>
                  let '(trans, ctxt) := function_parameter in
                  step log ctxt step_constants __descr_value trans))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Loop _, Item false rest) =>
          logged_return (rest, ctxt)
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Loop_left body,
            Item (Tezos_raw_protocol_alpha.Script_typed_ir.L v) rest) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.loop_cycle))
            (fun ctxt =>
              op_gtgteqquestion
                (step log ctxt step_constants body (Item v rest))
                (fun function_parameter =>
                  let '(trans, ctxt) := function_parameter in
                  step log ctxt step_constants __descr_value trans))
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Loop_left _,
            Item (Tezos_raw_protocol_alpha.Script_typed_ir.R v) rest) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.loop_cycle))
            (fun ctxt => logged_return ((Item v rest), ctxt))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Dip b, Item ign rest) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.stack_op))
            (fun ctxt =>
              op_gtgteqquestion (step log ctxt step_constants b rest)
                (fun function_parameter =>
                  let '(res, ctxt) := function_parameter in
                  logged_return ((Item ign res), ctxt)))
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Exec,
            Item arg (Item lam rest)) =>
          op_gtgteqquestion (Lwt.__return (Gas.consume ctxt Interp_costs.exec))
            (fun ctxt =>
              op_gtgteqquestion (interp log ctxt step_constants lam arg)
                (fun function_parameter =>
                  let '(res, ctxt) := function_parameter in
                  logged_return ((Item res rest), ctxt)))
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Apply capture_ty,
            Item capture (Item lam rest)) =>
          op_gtgteqquestion (Lwt.__return (Gas.consume ctxt Interp_costs.apply))
            (fun ctxt =>
              let
                'Tezos_raw_protocol_alpha.Script_typed_ir.Lam __descr_value expr :=
                lam in
              let
                'Tezos_raw_protocol_alpha.Script_typed_ir.Item_t full_arg_ty _ _ :=
                Tezos_raw_protocol_alpha.Script_typed_ir.descr.bef __descr_value
                in
              op_gtgteqquestion
                (unparse_data ctxt
                  Tezos_raw_protocol_alpha.Script_ir_translator.Optimized
                  capture_ty capture)
                (fun function_parameter =>
                  let '(const_expr, ctxt) := function_parameter in
                  op_gtgteqquestion (unparse_ty ctxt capture_ty)
                    (fun function_parameter =>
                      let '(ty_expr, ctxt) := function_parameter in
                      match full_arg_ty with
                      |
                        Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t
                          (capture_ty, _, _) (arg_ty, _, _) _ _ =>
                        let arg_stack_ty :=
                          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t arg_ty
                            Tezos_raw_protocol_alpha.Script_typed_ir.Empty_t
                            None in
                        let const_descr :=
                          {|
                            Tezos_raw_protocol_alpha.Script_typed_ir.descr.loc :=
                              Tezos_raw_protocol_alpha.Script_typed_ir.descr.loc
                                __descr_value;
                            Tezos_raw_protocol_alpha.Script_typed_ir.descr.bef :=
                              arg_stack_ty;
                            Tezos_raw_protocol_alpha.Script_typed_ir.descr.aft :=
                              Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                                capture_ty arg_stack_ty None;
                            Tezos_raw_protocol_alpha.Script_typed_ir.descr.instr :=
                              Tezos_raw_protocol_alpha.Script_typed_ir.Const
                                capture |} in
                        let pair_descr :=
                          {|
                            Tezos_raw_protocol_alpha.Script_typed_ir.descr.loc :=
                              Tezos_raw_protocol_alpha.Script_typed_ir.descr.loc
                                __descr_value;
                            Tezos_raw_protocol_alpha.Script_typed_ir.descr.bef :=
                              Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                                capture_ty arg_stack_ty None;
                            Tezos_raw_protocol_alpha.Script_typed_ir.descr.aft :=
                              Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                                full_arg_ty
                                Tezos_raw_protocol_alpha.Script_typed_ir.Empty_t
                                None;
                            Tezos_raw_protocol_alpha.Script_typed_ir.descr.instr :=
                              Tezos_raw_protocol_alpha.Script_typed_ir.Cons_pair
                            |} in
                        let seq_descr :=
                          {|
                            Tezos_raw_protocol_alpha.Script_typed_ir.descr.loc :=
                              Tezos_raw_protocol_alpha.Script_typed_ir.descr.loc
                                __descr_value;
                            Tezos_raw_protocol_alpha.Script_typed_ir.descr.bef :=
                              arg_stack_ty;
                            Tezos_raw_protocol_alpha.Script_typed_ir.descr.aft :=
                              Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                                full_arg_ty
                                Tezos_raw_protocol_alpha.Script_typed_ir.Empty_t
                                None;
                            Tezos_raw_protocol_alpha.Script_typed_ir.descr.instr :=
                              Tezos_raw_protocol_alpha.Script_typed_ir.Seq
                                const_descr pair_descr |} in
                        let full_descr :=
                          {|
                            Tezos_raw_protocol_alpha.Script_typed_ir.descr.loc :=
                              Tezos_raw_protocol_alpha.Script_typed_ir.descr.loc
                                __descr_value;
                            Tezos_raw_protocol_alpha.Script_typed_ir.descr.bef :=
                              arg_stack_ty;
                            Tezos_raw_protocol_alpha.Script_typed_ir.descr.aft :=
                              Tezos_raw_protocol_alpha.Script_typed_ir.descr.aft
                                __descr_value;
                            Tezos_raw_protocol_alpha.Script_typed_ir.descr.instr :=
                              Tezos_raw_protocol_alpha.Script_typed_ir.Seq
                                seq_descr __descr_value |} in
                        let full_expr :=
                          Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                            0
                            (cons
                              (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                0
                                Tezos_raw_protocol_alpha.Alpha_context.Script.I_PUSH
                                (cons ty_expr (cons const_expr [])) [])
                              (cons
                                (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                  0
                                  Tezos_raw_protocol_alpha.Alpha_context.Script.I_PAIR
                                  [] []) (cons expr []))) in
                        let lam' :=
                          Tezos_raw_protocol_alpha.Script_typed_ir.Lam
                            full_descr full_expr in
                        logged_return ((Item lam' rest), ctxt)
                      | _ =>
                        (* ❌ Assert instruction is not handled. *)
                        assert false
                      end)))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Lambda lam, rest) =>
          op_gtgteqquestion (Lwt.__return (Gas.consume ctxt Interp_costs.push))
            (fun ctxt => logged_return ((Item lam rest), ctxt))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Failwith tv, Item v _) =>
          op_gtgteqquestion
            (trace
              Tezos_protocol_environment_alpha__Environment.Error_monad.Cannot_serialize_failure
              (unparse_data ctxt
                Tezos_raw_protocol_alpha.Script_ir_translator.Optimized tv v))
            (fun function_parameter =>
              let '(v, _ctxt) := function_parameter in
              let v := Micheline.strip_locations v in
              fail
                (Tezos_protocol_environment_alpha__Environment.Error_monad.Reject
                  loc v (get_log log)))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Nop, stack) =>
          logged_return (stack, ctxt)
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Compare ty,
            Item a (Item b rest)) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt (Interp_costs.compare ty a b)))
            (fun ctxt =>
              logged_return
                ((Item
                  (op_atat Script_int.of_int
                    (Script_ir_translator.compare_comparable ty a b)) rest),
                  ctxt))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Eq, Item cmpres rest) =>
          let cmpres := Script_int.compare cmpres Script_int.zero in
          let cmpres := op_eq cmpres 0 in
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.compare_res))
            (fun ctxt => logged_return ((Item cmpres rest), ctxt))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Neq, Item cmpres rest) =>
          let cmpres := Script_int.compare cmpres Script_int.zero in
          let cmpres := op_ltgt cmpres 0 in
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.compare_res))
            (fun ctxt => logged_return ((Item cmpres rest), ctxt))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Lt, Item cmpres rest) =>
          let cmpres := Script_int.compare cmpres Script_int.zero in
          let cmpres := op_lt cmpres 0 in
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.compare_res))
            (fun ctxt => logged_return ((Item cmpres rest), ctxt))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Le, Item cmpres rest) =>
          let cmpres := Script_int.compare cmpres Script_int.zero in
          let cmpres := op_lteq cmpres 0 in
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.compare_res))
            (fun ctxt => logged_return ((Item cmpres rest), ctxt))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Gt, Item cmpres rest) =>
          let cmpres := Script_int.compare cmpres Script_int.zero in
          let cmpres := op_gt cmpres 0 in
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.compare_res))
            (fun ctxt => logged_return ((Item cmpres rest), ctxt))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Ge, Item cmpres rest) =>
          let cmpres := Script_int.compare cmpres Script_int.zero in
          let cmpres := op_gteq cmpres 0 in
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.compare_res))
            (fun ctxt => logged_return ((Item cmpres rest), ctxt))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Pack t, Item value rest) =>
          op_gtgteqquestion (Script_ir_translator.pack_data ctxt t value)
            (fun function_parameter =>
              let '(__bytes_value, ctxt) := function_parameter in
              logged_return ((Item __bytes_value rest), ctxt))
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Unpack t,
            Item __bytes_value rest) =>
          op_gtgteqquestion
            (Lwt.__return
              (Gas.check_enough ctxt (Script.serialized_cost __bytes_value)))
            (fun function_parameter =>
              let 'tt := function_parameter in
              if
                op_andand (op_gteq (MBytes.length __bytes_value) 1)
                  (op_eq (MBytes.get_uint8 __bytes_value 0) 5) then
                let __bytes_value :=
                  MBytes.sub __bytes_value 1
                    (op_minus (MBytes.length __bytes_value) 1) in
                match
                  Data_encoding.Binary.of_bytes Script.expr_encoding
                    __bytes_value with
                | None =>
                  op_gtgteqquestion
                    (Lwt.__return
                      (Gas.consume ctxt
                        (Interp_costs.unpack_failed __bytes_value)))
                    (fun ctxt => logged_return ((Item None rest), ctxt))
                | Some expr =>
                  op_gtgteqquestion
                    (Lwt.__return
                      (Gas.consume ctxt (Script.deserialized_cost expr)))
                    (fun ctxt =>
                      op_gtgteq
                        (parse_data None ctxt false t (Micheline.root expr))
                        (fun function_parameter =>
                          match function_parameter with
                          |
                            Tezos_protocol_environment_alpha__Environment.Pervasives.Ok
                              (value, ctxt) =>
                            logged_return ((Item (Some value) rest), ctxt)
                          |
                            Tezos_protocol_environment_alpha__Environment.Pervasives.Error
                              _ignored =>
                            op_gtgteqquestion
                              (Lwt.__return
                                (Gas.consume ctxt
                                  (Interp_costs.unpack_failed __bytes_value)))
                              (fun ctxt =>
                                logged_return ((Item None rest), ctxt))
                          end))
                end
              else
                logged_return ((Item None rest), ctxt))
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Address,
            Item (_, address) rest) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.address))
            (fun ctxt => logged_return ((Item address rest), ctxt))
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Contract t entrypoint,
            Item contract rest) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.contract))
            (fun ctxt =>
              match (contract, entrypoint) with
              |
                ((contract, "default" % string), entrypoint) |
                  ((contract, entrypoint), "default" % string) =>
                op_gtgteqquestion
                  (Script_ir_translator.parse_contract_for_script false ctxt loc
                    t contract entrypoint)
                  (fun function_parameter =>
                    let '(ctxt, maybe_contract) := function_parameter in
                    logged_return ((Item maybe_contract rest), ctxt))
              | _ => logged_return ((Item None rest), ctxt)
              end)
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Transfer_tokens,
            Item p (Item amount (Item (tp, (destination, entrypoint)) rest))) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.transfer))
            (fun ctxt =>
              op_gtgteqquestion (collect_big_maps ctxt tp p)
                (fun function_parameter =>
                  let '(to_duplicate, ctxt) := function_parameter in
                  let to_update := no_big_map_id in
                  op_gtgteqquestion
                    (extract_big_map_diff ctxt
                      Tezos_raw_protocol_alpha.Script_ir_translator.Optimized
                      true to_duplicate to_update tp p)
                    (fun function_parameter =>
                      let '(p, big_map_diff, ctxt) := function_parameter in
                      op_gtgteqquestion
                        (unparse_data ctxt
                          Tezos_raw_protocol_alpha.Script_ir_translator.Optimized
                          tp p)
                        (fun function_parameter =>
                          let '(p, ctxt) := function_parameter in
                          let operation :=
                            Tezos_raw_protocol_alpha.Alpha_context.Transaction
                              {|
                                Tezos_raw_protocol_alpha.Alpha_context.manager_operation.Transaction.amount :=
                                  amount;
                                Tezos_raw_protocol_alpha.Alpha_context.manager_operation.Transaction.parameters :=
                                  Script.lazy_expr (Micheline.strip_locations p);
                                Tezos_raw_protocol_alpha.Alpha_context.manager_operation.Transaction.entrypoint :=
                                  entrypoint;
                                Tezos_raw_protocol_alpha.Alpha_context.manager_operation.Transaction.destination :=
                                  destination |} in
                          op_gtgteqquestion
                            (Lwt.__return (fresh_internal_nonce ctxt))
                            (fun function_parameter =>
                              let '(ctxt, nonce) := function_parameter in
                              logged_return
                                ((Item
                                  ((Tezos_raw_protocol_alpha.Alpha_context.Internal_operation
                                    {|
                                      Tezos_raw_protocol_alpha.Alpha_context.internal_operation.source :=
                                        step_constants.self step_constants;
                                      Tezos_raw_protocol_alpha.Alpha_context.internal_operation.operation :=
                                        operation;
                                      Tezos_raw_protocol_alpha.Alpha_context.internal_operation.nonce :=
                                        nonce |}), big_map_diff) rest), ctxt))))))
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Create_account,
            Item manager (Item delegate (Item _delegatable (Item credit rest))))
          =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.create_account))
            (fun ctxt =>
              op_gtgteqquestion
                (Contract.fresh_contract_from_current_nonce ctxt)
                (fun function_parameter =>
                  let '(ctxt, contract) := function_parameter in
                  let manager_bytes :=
                    Data_encoding.Binary.to_bytes_exn
                      Signature.Public_key_hash.encoding manager in
                  let storage :=
                    op_atat Script_repr.lazy_expr
                      (op_atat Micheline.strip_locations
                        (Tezos_protocol_environment_alpha__Environment.Micheline.Bytes
                          0 manager_bytes)) in
                  let script :=
                    {|
                      Tezos_raw_protocol_alpha.Alpha_context.Script.t.code :=
                        Legacy_support.manager_script_code;
                      Tezos_raw_protocol_alpha.Alpha_context.Script.t.storage :=
                        storage |} in
                  let operation :=
                    Tezos_raw_protocol_alpha.Alpha_context.Origination
                      {|
                        Tezos_raw_protocol_alpha.Alpha_context.manager_operation.Origination.delegate :=
                          delegate;
                        Tezos_raw_protocol_alpha.Alpha_context.manager_operation.Origination.script :=
                          script;
                        Tezos_raw_protocol_alpha.Alpha_context.manager_operation.Origination.credit :=
                          credit;
                        Tezos_raw_protocol_alpha.Alpha_context.manager_operation.Origination.preorigination :=
                          Some contract |} in
                  op_gtgteqquestion (Lwt.__return (fresh_internal_nonce ctxt))
                    (fun function_parameter =>
                      let '(ctxt, nonce) := function_parameter in
                      logged_return
                        ((Item
                          ((Tezos_raw_protocol_alpha.Alpha_context.Internal_operation
                            {|
                              Tezos_raw_protocol_alpha.Alpha_context.internal_operation.source :=
                                step_constants.self step_constants;
                              Tezos_raw_protocol_alpha.Alpha_context.internal_operation.operation :=
                                operation;
                              Tezos_raw_protocol_alpha.Alpha_context.internal_operation.nonce :=
                                nonce |}), None)
                          (Item (contract, "default" % string) rest)), ctxt))))
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Implicit_account,
            Item key rest) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.implicit_account))
            (fun ctxt =>
              let contract := Contract.implicit_contract key in
              logged_return
                ((Item
                  ((Tezos_raw_protocol_alpha.Script_typed_ir.Unit_t None),
                    (contract, "default" % string)) rest), ctxt))
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Create_contract storage_type
            param_type (Tezos_raw_protocol_alpha.Script_typed_ir.Lam _ code)
            root_name,
            Item manager
              (Item delegate
                (Item spendable
                  (Item delegatable (Item credit (Item init rest)))))) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.create_contract))
            (fun ctxt =>
              op_gtgteqquestion (unparse_ty ctxt param_type)
                (fun function_parameter =>
                  let '(unparsed_param_type, ctxt) := function_parameter in
                  let unparsed_param_type :=
                    Script_ir_translator.add_field_annot
                      (Option.map
                        (fun n =>
                          (* ❌ Variants not supported *)
                          variant) root_name) None unparsed_param_type in
                  op_gtgteqquestion (unparse_ty ctxt storage_type)
                    (fun function_parameter =>
                      let '(unparsed_storage_type, ctxt) := function_parameter
                        in
                      let code :=
                        op_atat Script.lazy_expr
                          (Micheline.strip_locations
                            (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                              0
                              (cons
                                (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                  0
                                  Tezos_raw_protocol_alpha.Alpha_context.Script.K_parameter
                                  (cons unparsed_param_type []) [])
                                (cons
                                  (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                    0
                                    Tezos_raw_protocol_alpha.Alpha_context.Script.K_storage
                                    (cons unparsed_storage_type []) [])
                                  (cons
                                    (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                      0
                                      Tezos_raw_protocol_alpha.Alpha_context.Script.K_code
                                      (cons code []) []) []))))) in
                      op_gtgteqquestion
                        (collect_big_maps ctxt storage_type init)
                        (fun function_parameter =>
                          let '(to_duplicate, ctxt) := function_parameter in
                          let to_update := no_big_map_id in
                          op_gtgteqquestion
                            (extract_big_map_diff ctxt
                              Tezos_raw_protocol_alpha.Script_ir_translator.Optimized
                              true to_duplicate to_update storage_type init)
                            (fun function_parameter =>
                              let '(init, big_map_diff, ctxt) :=
                                function_parameter in
                              op_gtgteqquestion
                                (unparse_data ctxt
                                  Tezos_raw_protocol_alpha.Script_ir_translator.Optimized
                                  storage_type init)
                                (fun function_parameter =>
                                  let '(storage, ctxt) := function_parameter in
                                  let storage :=
                                    op_atat Script.lazy_expr
                                      (Micheline.strip_locations storage) in
                                  op_gtgteqquestion
                                    (if spendable then
                                      Legacy_support.add_do manager code storage
                                    else
                                      if delegatable then
                                        Legacy_support.add_set_delegate manager
                                          code storage
                                      else
                                        if
                                          Legacy_support.has_default_entrypoint
                                            code then
                                          op_gtgteqquestion
                                            (Legacy_support.add_root_entrypoint
                                              code)
                                            (fun code =>
                                              __return (code, storage))
                                        else
                                          __return (code, storage))
                                    (fun function_parameter =>
                                      let '(code, storage) := function_parameter
                                        in
                                      op_gtgteqquestion
                                        (Contract.fresh_contract_from_current_nonce
                                          ctxt)
                                        (fun function_parameter =>
                                          let '(ctxt, contract) :=
                                            function_parameter in
                                          let operation :=
                                            Tezos_raw_protocol_alpha.Alpha_context.Origination
                                              {|
                                                Tezos_raw_protocol_alpha.Alpha_context.manager_operation.Origination.delegate :=
                                                  delegate;
                                                Tezos_raw_protocol_alpha.Alpha_context.manager_operation.Origination.script :=
                                                  {|
                                                    Tezos_raw_protocol_alpha.Alpha_context.Script.t.code :=
                                                      code;
                                                    Tezos_raw_protocol_alpha.Alpha_context.Script.t.storage :=
                                                      storage |};
                                                Tezos_raw_protocol_alpha.Alpha_context.manager_operation.Origination.credit :=
                                                  credit;
                                                Tezos_raw_protocol_alpha.Alpha_context.manager_operation.Origination.preorigination :=
                                                  Some contract |} in
                                          op_gtgteqquestion
                                            (Lwt.__return
                                              (fresh_internal_nonce ctxt))
                                            (fun function_parameter =>
                                              let '(ctxt, nonce) :=
                                                function_parameter in
                                              logged_return
                                                ((Item
                                                  ((Tezos_raw_protocol_alpha.Alpha_context.Internal_operation
                                                    {|
                                                      Tezos_raw_protocol_alpha.Alpha_context.internal_operation.source :=
                                                        step_constants.self
                                                          step_constants;
                                                      Tezos_raw_protocol_alpha.Alpha_context.internal_operation.operation :=
                                                        operation;
                                                      Tezos_raw_protocol_alpha.Alpha_context.internal_operation.nonce :=
                                                        nonce |}), big_map_diff)
                                                  (Item
                                                    (contract,
                                                      "default" % string) rest)),
                                                  ctxt))))))))))
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Create_contract_2
            storage_type param_type
            (Tezos_raw_protocol_alpha.Script_typed_ir.Lam _ code) root_name,
            Item delegate (Item credit (Item init rest))) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.create_contract))
            (fun ctxt =>
              op_gtgteqquestion (unparse_ty ctxt param_type)
                (fun function_parameter =>
                  let '(unparsed_param_type, ctxt) := function_parameter in
                  let unparsed_param_type :=
                    Script_ir_translator.add_field_annot
                      (Option.map
                        (fun n =>
                          (* ❌ Variants not supported *)
                          variant) root_name) None unparsed_param_type in
                  op_gtgteqquestion (unparse_ty ctxt storage_type)
                    (fun function_parameter =>
                      let '(unparsed_storage_type, ctxt) := function_parameter
                        in
                      let code :=
                        Micheline.strip_locations
                          (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                            0
                            (cons
                              (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                0
                                Tezos_raw_protocol_alpha.Alpha_context.Script.K_parameter
                                (cons unparsed_param_type []) [])
                              (cons
                                (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                  0
                                  Tezos_raw_protocol_alpha.Alpha_context.Script.K_storage
                                  (cons unparsed_storage_type []) [])
                                (cons
                                  (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                    0
                                    Tezos_raw_protocol_alpha.Alpha_context.Script.K_code
                                    (cons code []) []) [])))) in
                      op_gtgteqquestion
                        (collect_big_maps ctxt storage_type init)
                        (fun function_parameter =>
                          let '(to_duplicate, ctxt) := function_parameter in
                          let to_update := no_big_map_id in
                          op_gtgteqquestion
                            (extract_big_map_diff ctxt
                              Tezos_raw_protocol_alpha.Script_ir_translator.Optimized
                              true to_duplicate to_update storage_type init)
                            (fun function_parameter =>
                              let '(init, big_map_diff, ctxt) :=
                                function_parameter in
                              op_gtgteqquestion
                                (unparse_data ctxt
                                  Tezos_raw_protocol_alpha.Script_ir_translator.Optimized
                                  storage_type init)
                                (fun function_parameter =>
                                  let '(storage, ctxt) := function_parameter in
                                  let storage :=
                                    Micheline.strip_locations storage in
                                  op_gtgteqquestion
                                    (Contract.fresh_contract_from_current_nonce
                                      ctxt)
                                    (fun function_parameter =>
                                      let '(ctxt, contract) :=
                                        function_parameter in
                                      let operation :=
                                        Tezos_raw_protocol_alpha.Alpha_context.Origination
                                          {|
                                            Tezos_raw_protocol_alpha.Alpha_context.manager_operation.Origination.delegate :=
                                              delegate;
                                            Tezos_raw_protocol_alpha.Alpha_context.manager_operation.Origination.script :=
                                              {|
                                                Tezos_raw_protocol_alpha.Alpha_context.Script.t.code :=
                                                  Script.lazy_expr code;
                                                Tezos_raw_protocol_alpha.Alpha_context.Script.t.storage :=
                                                  Script.lazy_expr storage |};
                                            Tezos_raw_protocol_alpha.Alpha_context.manager_operation.Origination.credit :=
                                              credit;
                                            Tezos_raw_protocol_alpha.Alpha_context.manager_operation.Origination.preorigination :=
                                              Some contract |} in
                                      op_gtgteqquestion
                                        (Lwt.__return
                                          (fresh_internal_nonce ctxt))
                                        (fun function_parameter =>
                                          let '(ctxt, nonce) :=
                                            function_parameter in
                                          logged_return
                                            ((Item
                                              ((Tezos_raw_protocol_alpha.Alpha_context.Internal_operation
                                                {|
                                                  Tezos_raw_protocol_alpha.Alpha_context.internal_operation.source :=
                                                    step_constants.self
                                                      step_constants;
                                                  Tezos_raw_protocol_alpha.Alpha_context.internal_operation.operation :=
                                                    operation;
                                                  Tezos_raw_protocol_alpha.Alpha_context.internal_operation.nonce :=
                                                    nonce |}), big_map_diff)
                                              (Item
                                                (contract, "default" % string)
                                                rest)), ctxt)))))))))
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Set_delegate,
            Item delegate rest) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.create_account))
            (fun ctxt =>
              let operation :=
                Tezos_raw_protocol_alpha.Alpha_context.Delegation delegate in
              op_gtgteqquestion (Lwt.__return (fresh_internal_nonce ctxt))
                (fun function_parameter =>
                  let '(ctxt, nonce) := function_parameter in
                  logged_return
                    ((Item
                      ((Tezos_raw_protocol_alpha.Alpha_context.Internal_operation
                        {|
                          Tezos_raw_protocol_alpha.Alpha_context.internal_operation.source :=
                            step_constants.self step_constants;
                          Tezos_raw_protocol_alpha.Alpha_context.internal_operation.operation :=
                            operation;
                          Tezos_raw_protocol_alpha.Alpha_context.internal_operation.nonce :=
                            nonce |}), None) rest), ctxt)))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Balance, rest) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.balance))
            (fun ctxt =>
              op_gtgteqquestion
                (Contract.get_balance ctxt (step_constants.self step_constants))
                (fun balance => logged_return ((Item balance rest), ctxt)))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Now, rest) =>
          op_gtgteqquestion (Lwt.__return (Gas.consume ctxt Interp_costs.now))
            (fun ctxt =>
              let now := Script_timestamp.now ctxt in
              logged_return ((Item now rest), ctxt))
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Check_signature,
            Item key (Item signature (Item message rest))) =>
          op_gtgteqquestion
            (Lwt.__return
              (Gas.consume ctxt (Interp_costs.check_signature key message)))
            (fun ctxt =>
              let res := Signature.check None key signature message in
              logged_return ((Item res rest), ctxt))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Hash_key, Item key rest) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.hash_key))
            (fun ctxt =>
              logged_return
                ((Item (Signature.Public_key.__hash_value key) rest), ctxt))
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Blake2b,
            Item __bytes_value rest) =>
          op_gtgteqquestion
            (Lwt.__return
              (Gas.consume ctxt (Interp_costs.hash_blake2b __bytes_value)))
            (fun ctxt =>
              let __hash_value := Raw_hashes.blake2b __bytes_value in
              logged_return ((Item __hash_value rest), ctxt))
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Sha256,
            Item __bytes_value rest) =>
          op_gtgteqquestion
            (Lwt.__return
              (Gas.consume ctxt (Interp_costs.hash_sha256 __bytes_value)))
            (fun ctxt =>
              let __hash_value := Raw_hashes.sha256 __bytes_value in
              logged_return ((Item __hash_value rest), ctxt))
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Sha512,
            Item __bytes_value rest) =>
          op_gtgteqquestion
            (Lwt.__return
              (Gas.consume ctxt (Interp_costs.hash_sha512 __bytes_value)))
            (fun ctxt =>
              let __hash_value := Raw_hashes.sha512 __bytes_value in
              logged_return ((Item __hash_value rest), ctxt))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Steps_to_quota, rest) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.steps_to_quota))
            (fun ctxt =>
              let steps :=
                match Gas.level ctxt with
                |
                  Tezos_raw_protocol_alpha.Alpha_context.Gas.Limited {|
                    Tezos_raw_protocol_alpha.Alpha_context.Gas.t.Limited.remaining := remaining
                      |} => remaining
                | Tezos_raw_protocol_alpha.Alpha_context.Gas.Unaccounted =>
                  Z.of_string "99999999" % string
                end in
              logged_return ((Item (abs (of_zint steps)) rest), ctxt))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Source, rest) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.source))
            (fun ctxt =>
              logged_return
                ((Item
                  ((step_constants.payer step_constants), "default" % string)
                  rest), ctxt))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Sender, rest) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.source))
            (fun ctxt =>
              logged_return
                ((Item
                  ((step_constants.source step_constants), "default" % string)
                  rest), ctxt))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Self t entrypoint, rest) =>
          op_gtgteqquestion (Lwt.__return (Gas.consume ctxt Interp_costs.self))
            (fun ctxt =>
              logged_return
                ((Item (t, ((step_constants.self step_constants), entrypoint))
                  rest), ctxt))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Amount, rest) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.amount))
            (fun ctxt =>
              logged_return
                ((Item (step_constants.amount step_constants) rest), ctxt))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Dig n n', stack) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt (Interp_costs.stack_n_op n)))
            (fun ctxt =>
              op_gtgteqquestion
                (interp_stack_prefix_preserving_operation
                  (fun function_parameter =>
                    let 'Item v rest := function_parameter in
                    __return (rest, v)) n' stack)
                (fun function_parameter =>
                  let '(aft, x) := function_parameter in
                  logged_return ((Item x aft), ctxt)))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Dug n n', Item v rest) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt (Interp_costs.stack_n_op n)))
            (fun ctxt =>
              op_gtgteqquestion
                (interp_stack_prefix_preserving_operation
                  (fun stk => __return ((Item v stk), tt)) n' rest)
                (fun function_parameter =>
                  let '(aft, tt) := function_parameter in
                  logged_return (aft, ctxt)))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Dipn n n' b, stack) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt (Interp_costs.stack_n_op n)))
            (fun ctxt =>
              op_gtgteqquestion
                (interp_stack_prefix_preserving_operation
                  (fun stk =>
                    op_gtgteqquestion (step log ctxt step_constants b stk)
                      (fun function_parameter =>
                        let '(res, ctxt') := function_parameter in
                        __return (res, ctxt'))) n' stack)
                (fun function_parameter =>
                  let '(aft, ctxt') := function_parameter in
                  logged_return (aft, ctxt')))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Dropn n n', stack) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt (Interp_costs.stack_n_op n)))
            (fun ctxt =>
              op_gtgteqquestion
                (interp_stack_prefix_preserving_operation
                  (fun stk => __return (stk, stk)) n' stack)
                (fun function_parameter =>
                  let '(_, rest) := function_parameter in
                  logged_return (rest, ctxt)))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.ChainId, rest) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.chain_id))
            (fun ctxt =>
              logged_return
                ((Item (step_constants.chain_id step_constants) rest), ctxt))
        end)

with interp {p r : Set}
  (log :
    option
      (Tezos_protocol_environment_alpha__Environment.Pervasives.ref
        execution_trace))
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
  (step_constants : step_constants)
  (function_parameter : Tezos_raw_protocol_alpha.Script_typed_ir.lambda p r)
  : p ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (r * Tezos_raw_protocol_alpha.Alpha_context.context)) :=
  let 'Tezos_raw_protocol_alpha.Script_typed_ir.Lam code _ := function_parameter
    in
  fun arg =>
    let stack := Item arg Empty in
    op_gtgteqquestion
      match log with
      | None => return_unit
      | Some log =>
        op_gtgteqquestion
          (trace
            Tezos_protocol_environment_alpha__Environment.Error_monad.Cannot_serialize_log
            (unparse_stack ctxt
              (stack, (Tezos_raw_protocol_alpha.Script_typed_ir.descr.bef code))))
          (fun stack =>
            (* ❌ Sequences of instructions are not handled (operator ";") *)
            let _ :=
              op_coloneq log
                (cons
                  ((Tezos_raw_protocol_alpha.Script_typed_ir.descr.loc code),
                    (Gas.level ctxt), stack) (op_exclamation log)) in
            return_unit)
      end
      (fun function_parameter =>
        let 'tt := function_parameter in
        op_gtgteqquestion (step log ctxt step_constants code stack)
          (fun function_parameter =>
            let '(Item ret Empty, ctxt) := function_parameter in
            __return (ret, ctxt)))

with execute
  (log :
    option
      (Tezos_protocol_environment_alpha__Environment.Pervasives.ref
        execution_trace))
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
  (mode : Tezos_raw_protocol_alpha.Script_ir_translator.unparsing_mode)
  (step_constants : step_constants) (entrypoint : string)
  (unparsed_script : Tezos_raw_protocol_alpha.Alpha_context.Script.t)
  (arg : Tezos_raw_protocol_alpha.Alpha_context.Script.node)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
        list Tezos_raw_protocol_alpha.Alpha_context.packed_internal_operation *
        Tezos_raw_protocol_alpha.Alpha_context.context *
        option Tezos_raw_protocol_alpha.Alpha_context.Contract.big_map_diff)) :=
  op_gtgteqquestion (parse_script None ctxt true unparsed_script)
    (fun function_parameter =>
      let
        '(Tezos_raw_protocol_alpha.Script_ir_translator.Ex_script {|
          Tezos_raw_protocol_alpha.Script_typed_ir.script.code := code;
            Tezos_raw_protocol_alpha.Script_typed_ir.script.arg_type := arg_type;
            Tezos_raw_protocol_alpha.Script_typed_ir.script.storage := storage;
            Tezos_raw_protocol_alpha.Script_typed_ir.script.storage_type :=
              storage_type;
            Tezos_raw_protocol_alpha.Script_typed_ir.script.root_name :=
              root_name
            |}, ctxt) := function_parameter in
      op_gtgteqquestion
        (trace
          (Tezos_protocol_environment_alpha__Environment.Error_monad.Bad_contract_parameter
            (step_constants.self step_constants))
          (Lwt.__return (find_entrypoint arg_type root_name entrypoint)))
        (fun function_parameter =>
          let '(box, _) := function_parameter in
          op_gtgteqquestion
            (trace
              (Tezos_protocol_environment_alpha__Environment.Error_monad.Bad_contract_parameter
                (step_constants.self step_constants))
              (parse_data None ctxt false arg_type (box arg)))
            (fun function_parameter =>
              let '(arg, ctxt) := function_parameter in
              op_gtgteqquestion
                (Script.force_decode ctxt
                  (Tezos_raw_protocol_alpha.Alpha_context.Script.t.code
                    unparsed_script))
                (fun function_parameter =>
                  let '(script_code, ctxt) := function_parameter in
                  op_gtgteqquestion
                    (Script_ir_translator.collect_big_maps ctxt arg_type arg)
                    (fun function_parameter =>
                      let '(to_duplicate, ctxt) := function_parameter in
                      op_gtgteqquestion
                        (Script_ir_translator.collect_big_maps ctxt storage_type
                          storage)
                        (fun function_parameter =>
                          let '(to_update, ctxt) := function_parameter in
                          op_gtgteqquestion
                            (trace
                              (Tezos_protocol_environment_alpha__Environment.Error_monad.Runtime_contract_error
                                (step_constants.self step_constants) script_code)
                              (interp log ctxt step_constants code
                                (arg, storage)))
                            (fun function_parameter =>
                              let '((ops, storage), ctxt) := function_parameter
                                in
                              op_gtgteqquestion
                                (Script_ir_translator.extract_big_map_diff ctxt
                                  mode false to_duplicate to_update storage_type
                                  storage)
                                (fun function_parameter =>
                                  let '(storage, big_map_diff, ctxt) :=
                                    function_parameter in
                                  op_gtgteqquestion
                                    (trace
                                      Tezos_protocol_environment_alpha__Environment.Error_monad.Cannot_serialize_storage
                                      (unparse_data ctxt mode storage_type
                                        storage))
                                    (fun function_parameter =>
                                      let '(storage, ctxt) := function_parameter
                                        in
                                      let '(ops, op_diffs) := List.split ops in
                                      let big_map_diff :=
                                        match
                                          List.flatten
                                            (List.map (Option.unopt [])
                                              (op_at op_diffs
                                                (cons big_map_diff []))) with
                                        | [] => None
                                        | diff => Some diff
                                        end in
                                      __return
                                        ((Micheline.strip_locations storage),
                                          ops, ctxt, big_map_diff)))))))))).

Module execution_result.
  Record record := {
    ctxt : Tezos_raw_protocol_alpha.Alpha_context.context;
    storage : Tezos_raw_protocol_alpha.Alpha_context.Script.expr;
    big_map_diff :
      option Tezos_raw_protocol_alpha.Alpha_context.Contract.big_map_diff;
    operations :
      list Tezos_raw_protocol_alpha.Alpha_context.packed_internal_operation }.
End execution_result.
Definition execution_result := execution_result.record.

Definition trace
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
  (mode : Tezos_raw_protocol_alpha.Script_ir_translator.unparsing_mode)
  (step_constants : step_constants)
  (script : Tezos_raw_protocol_alpha.Alpha_context.Script.t)
  (entrypoint : string)
  (parameter :
    Tezos_protocol_environment_alpha__Environment.Micheline.canonical
      Tezos_raw_protocol_alpha.Alpha_context.Script.prim)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (execution_result *
        list
          (Tezos_raw_protocol_alpha.Alpha_context.Script.location *
            Tezos_raw_protocol_alpha.Alpha_context.Gas.t *
            list
              (Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
                option string)))) :=
  let log := __ref_value [] in
  op_gtgteqquestion
    (execute (Some log) ctxt mode step_constants entrypoint script
      (Micheline.root parameter))
    (fun function_parameter =>
      let '(storage, operations, ctxt, big_map_diff) := function_parameter in
      let trace := List.rev (op_exclamation log) in
      __return
        ({| execution_result.ctxt := ctxt; execution_result.storage := storage;
          execution_result.big_map_diff := big_map_diff;
          execution_result.operations := operations |}, trace)).

Definition execute
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
  (mode : Tezos_raw_protocol_alpha.Script_ir_translator.unparsing_mode)
  (step_constants : step_constants)
  (script : Tezos_raw_protocol_alpha.Alpha_context.Script.t)
  (entrypoint : string)
  (parameter :
    Tezos_protocol_environment_alpha__Environment.Micheline.canonical
      Tezos_raw_protocol_alpha.Alpha_context.Script.prim)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      execution_result) :=
  op_gtgteqquestion
    (execute None ctxt mode step_constants entrypoint script
      (Micheline.root parameter))
    (fun function_parameter =>
      let '(storage, operations, ctxt, big_map_diff) := function_parameter in
      __return
        {| execution_result.ctxt := ctxt; execution_result.storage := storage;
          execution_result.big_map_diff := big_map_diff;
          execution_result.operations := operations |}).

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Alpha_context

type execution_trace =
  (Script.location * Gas.t * (Script.expr * string option) list) list

type error +=
  | Reject of Script.location * Script.expr * execution_trace option

type error += Overflow of Script.location * execution_trace option

type error += Runtime_contract_error : Contract.t * Script.expr -> error

type error += Bad_contract_parameter of Contract.t (* `Permanent *)

type error += Cannot_serialize_log

type error += Cannot_serialize_failure

type error += Cannot_serialize_storage

type execution_result = {
  ctxt : context;
  storage : Script.expr;
  big_map_diff : Contract.big_map_diff option;
  operations : packed_internal_operation list;
}

type step_constants = {
  source : Contract.t;
  payer : Contract.t;
  self : Contract.t;
  amount : Tez.t;
  chain_id : Chain_id.t;
}

type 'tys stack =
  | Item : 'ty * 'rest stack -> ('ty * 'rest) stack
  | Empty : Script_typed_ir.end_of_stack stack

val step :
  ?log:execution_trace ref ->
  context ->
  step_constants ->
  ('bef, 'aft) Script_typed_ir.descr ->
  'bef stack ->
  ('aft stack * context) tzresult Lwt.t

val execute :
  Alpha_context.t ->
  Script_ir_translator.unparsing_mode ->
  step_constants ->
  script:Script.t ->
  entrypoint:string ->
  parameter:Script.expr ->
  execution_result tzresult Lwt.t

val trace :
  Alpha_context.t ->
  Script_ir_translator.unparsing_mode ->
  step_constants ->
  script:Script.t ->
  entrypoint:string ->
  parameter:Script.expr ->
  (execution_result * execution_trace) tzresult Lwt.t

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Definition execution_trace :=
  list
    (Tezos_raw_protocol_alpha.Alpha_context.Script.location *
      Tezos_raw_protocol_alpha.Alpha_context.Gas.t *
      list (Tezos_raw_protocol_alpha.Alpha_context.Script.expr * option string)).

(* extensible_type Tezos_protocol_environment_alpha__Environment.Error_monad.error *)

(* extensible_type Tezos_protocol_environment_alpha__Environment.Error_monad.error *)

(* extensible_type Tezos_protocol_environment_alpha__Environment.Error_monad.error *)

(* extensible_type Tezos_protocol_environment_alpha__Environment.Error_monad.error *)

(* extensible_type Tezos_protocol_environment_alpha__Environment.Error_monad.error *)

(* extensible_type Tezos_protocol_environment_alpha__Environment.Error_monad.error *)

(* extensible_type Tezos_protocol_environment_alpha__Environment.Error_monad.error *)

Module execution_result.
  Record record := {
    ctxt : Tezos_raw_protocol_alpha.Alpha_context.context;
    storage : Tezos_raw_protocol_alpha.Alpha_context.Script.expr;
    big_map_diff :
      option Tezos_raw_protocol_alpha.Alpha_context.Contract.big_map_diff;
    operations :
      list Tezos_raw_protocol_alpha.Alpha_context.packed_internal_operation }.
End execution_result.
Definition execution_result := execution_result.record.

Module step_constants.
  Record record := {
    source : Tezos_raw_protocol_alpha.Alpha_context.Contract.t;
    payer : Tezos_raw_protocol_alpha.Alpha_context.Contract.t;
    self : Tezos_raw_protocol_alpha.Alpha_context.Contract.t;
    amount : Tezos_raw_protocol_alpha.Alpha_context.Tez.t;
    chain_id : Tezos_protocol_environment_alpha__Environment.Chain_id.t }.
End step_constants.
Definition step_constants := step_constants.record.

Reserved Notation "'stack".

Inductive stack_gadt : Set :=
| Item : forall {ty : Set}, ty -> stack_gadt -> stack_gadt
| Empty : stack_gadt

where "'stack" := (fun (tys : Set) => stack_gadt).

Definition stack := 'stack.

Parameter step : forall {aft bef : Set},
  option
    (Tezos_protocol_environment_alpha__Environment.Pervasives.ref
      execution_trace) -> Tezos_raw_protocol_alpha.Alpha_context.context ->
  step_constants -> Tezos_raw_protocol_alpha.Script_typed_ir.descr bef aft ->
  stack bef ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (stack aft * Tezos_raw_protocol_alpha.Alpha_context.context)).

Parameter execute :
  Tezos_raw_protocol_alpha.Alpha_context.t ->
  Tezos_raw_protocol_alpha.Script_ir_translator.unparsing_mode ->
  step_constants -> Tezos_raw_protocol_alpha.Alpha_context.Script.t -> string ->
  Tezos_raw_protocol_alpha.Alpha_context.Script.expr ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      execution_result).

Parameter trace :
  Tezos_raw_protocol_alpha.Alpha_context.t ->
  Tezos_raw_protocol_alpha.Script_ir_translator.unparsing_mode ->
  step_constants -> Tezos_raw_protocol_alpha.Alpha_context.Script.t -> string ->
  Tezos_raw_protocol_alpha.Alpha_context.Script.expr ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (execution_result * execution_trace)).

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Alpha_context
open Micheline
open Script_tc_errors
open Script_typed_ir

let default_now_annot = Some (`Var_annot "now")

let default_amount_annot = Some (`Var_annot "amount")

let default_balance_annot = Some (`Var_annot "balance")

let default_steps_annot = Some (`Var_annot "steps")

let default_source_annot = Some (`Var_annot "source")

let default_sender_annot = Some (`Var_annot "sender")

let default_self_annot = Some (`Var_annot "self")

let default_arg_annot = Some (`Var_annot "arg")

let default_param_annot = Some (`Var_annot "parameter")

let default_storage_annot = Some (`Var_annot "storage")

let default_car_annot = Some (`Field_annot "car")

let default_cdr_annot = Some (`Field_annot "cdr")

let default_contract_annot = Some (`Field_annot "contract")

let default_addr_annot = Some (`Field_annot "address")

let default_manager_annot = Some (`Field_annot "manager")

let default_pack_annot = Some (`Field_annot "packed")

let default_unpack_annot = Some (`Field_annot "unpacked")

let default_slice_annot = Some (`Field_annot "slice")

let default_elt_annot = Some (`Field_annot "elt")

let default_key_annot = Some (`Field_annot "key")

let default_hd_annot = Some (`Field_annot "hd")

let default_tl_annot = Some (`Field_annot "tl")

let default_some_annot = Some (`Field_annot "some")

let default_left_annot = Some (`Field_annot "left")

let default_right_annot = Some (`Field_annot "right")

let default_binding_annot = Some (`Field_annot "bnd")

let unparse_type_annot : type_annot option -> string list = function
  | None ->
      []
  | Some (`Type_annot a) ->
      [":" ^ a]

let unparse_var_annot : var_annot option -> string list = function
  | None ->
      []
  | Some (`Var_annot a) ->
      ["@" ^ a]

let unparse_field_annot : field_annot option -> string list = function
  | None ->
      []
  | Some (`Field_annot a) ->
      ["%" ^ a]

let field_to_var_annot : field_annot option -> var_annot option = function
  | None ->
      None
  | Some (`Field_annot s) ->
      Some (`Var_annot s)

let type_to_var_annot : type_annot option -> var_annot option = function
  | None ->
      None
  | Some (`Type_annot s) ->
      Some (`Var_annot s)

let var_to_field_annot : var_annot option -> field_annot option = function
  | None ->
      None
  | Some (`Var_annot s) ->
      Some (`Field_annot s)

let default_annot ~default = function None -> default | annot -> annot

let gen_access_annot :
    var_annot option ->
    ?default:field_annot option ->
    field_annot option ->
    var_annot option =
 fun value_annot ?(default = None) field_annot ->
  match (value_annot, field_annot, default) with
  | (None, None, _) | (Some _, None, None) | (None, Some (`Field_annot ""), _)
    ->
      None
  | (None, Some (`Field_annot f), _) ->
      Some (`Var_annot f)
  | ( Some (`Var_annot v),
      (None | Some (`Field_annot "")),
      Some (`Field_annot f) ) ->
      Some (`Var_annot (String.concat "." [v; f]))
  | (Some (`Var_annot v), Some (`Field_annot f), _) ->
      Some (`Var_annot (String.concat "." [v; f]))

let merge_type_annot :
    legacy:bool ->
    type_annot option ->
    type_annot option ->
    type_annot option tzresult =
 fun ~legacy annot1 annot2 ->
  match (annot1, annot2) with
  | (None, None) | (Some _, None) | (None, Some _) ->
      ok None
  | (Some (`Type_annot a1), Some (`Type_annot a2)) ->
      if legacy || String.equal a1 a2 then ok annot1
      else error (Inconsistent_annotations (":" ^ a1, ":" ^ a2))

let merge_field_annot :
    legacy:bool ->
    field_annot option ->
    field_annot option ->
    field_annot option tzresult =
 fun ~legacy annot1 annot2 ->
  match (annot1, annot2) with
  | (None, None) | (Some _, None) | (None, Some _) ->
      ok None
  | (Some (`Field_annot a1), Some (`Field_annot a2)) ->
      if legacy || String.equal a1 a2 then ok annot1
      else error (Inconsistent_annotations ("%" ^ a1, "%" ^ a2))

let merge_var_annot : var_annot option -> var_annot option -> var_annot option
    =
 fun annot1 annot2 ->
  match (annot1, annot2) with
  | (None, None) | (Some _, None) | (None, Some _) ->
      None
  | (Some (`Var_annot a1), Some (`Var_annot a2)) ->
      if String.equal a1 a2 then annot1 else None

let error_unexpected_annot loc annot =
  match annot with [] -> ok () | _ :: _ -> error (Unexpected_annotation loc)

let fail_unexpected_annot loc annot =
  Lwt.return (error_unexpected_annot loc annot)

let parse_annots loc ?(allow_special_var = false)
    ?(allow_special_field = false) l =
  (* allow emtpty annotations as wildcards but otherwise only accept
     annotations that start with [a-zA-Z_] *)
  let sub_or_wildcard ~specials wrap s acc =
    let len = String.length s in
    if Compare.Int.(len = 1) then ok @@ (wrap None :: acc)
    else
      match s.[1] with
      | 'a' .. 'z' | 'A' .. 'Z' | '_' ->
          ok @@ (wrap (Some (String.sub s 1 (len - 1))) :: acc)
      | '@' when Compare.Int.(len = 2) && List.mem '@' specials ->
          ok @@ (wrap (Some "@") :: acc)
      | '%' when List.mem '%' specials ->
          if Compare.Int.(len = 2) then ok @@ (wrap (Some "%") :: acc)
          else if Compare.Int.(len = 3) && Compare.Char.(s.[2] = '%') then
            ok @@ (wrap (Some "%%") :: acc)
          else error (Unexpected_annotation loc)
      | _ ->
          error (Unexpected_annotation loc)
  in
  List.fold_left
    (fun acc s ->
      acc
      >>? fun acc ->
      if Compare.Int.(String.length s = 0) then
        error (Unexpected_annotation loc)
      else
        match s.[0] with
        | ':' ->
            sub_or_wildcard ~specials:[] (fun a -> `Type_annot a) s acc
        | '@' ->
            sub_or_wildcard
              ~specials:(if allow_special_var then ['%'] else [])
              (fun a -> `Var_annot a)
              s
              acc
        | '%' ->
            sub_or_wildcard
              ~specials:(if allow_special_field then ['@'] else [])
              (fun a -> `Field_annot a)
              s
              acc
        | _ ->
            error (Unexpected_annotation loc))
    (ok [])
    l
  >|? List.rev

let opt_var_of_var_opt = function
  | `Var_annot None ->
      None
  | `Var_annot (Some a) ->
      Some (`Var_annot a)

let opt_field_of_field_opt = function
  | `Field_annot None ->
      None
  | `Field_annot (Some a) ->
      Some (`Field_annot a)

let opt_type_of_type_opt = function
  | `Type_annot None ->
      None
  | `Type_annot (Some a) ->
      Some (`Type_annot a)

let classify_annot loc l :
    (var_annot option list * type_annot option list * field_annot option list)
    tzresult =
  try
    let (_, rv, _, rt, _, rf) =
      List.fold_left
        (fun (in_v, rv, in_t, rt, in_f, rf) a ->
          match (a, in_v, rv, in_t, rt, in_f, rf) with
          | ((`Var_annot _ as a), true, _, _, _, _, _)
          | ((`Var_annot _ as a), false, [], _, _, _, _) ->
              (true, opt_var_of_var_opt a :: rv, false, rt, false, rf)
          | ((`Type_annot _ as a), _, _, true, _, _, _)
          | ((`Type_annot _ as a), _, _, false, [], _, _) ->
              (false, rv, true, opt_type_of_type_opt a :: rt, false, rf)
          | ((`Field_annot _ as a), _, _, _, _, true, _)
          | ((`Field_annot _ as a), _, _, _, _, false, []) ->
              (false, rv, false, rt, true, opt_field_of_field_opt a :: rf)
          | _ ->
              raise Exit)
        (false, [], false, [], false, [])
        l
    in
    ok (List.rev rv, List.rev rt, List.rev rf)
  with Exit -> error (Ungrouped_annotations loc)

let get_one_annot loc = function
  | [] ->
      ok None
  | [a] ->
      ok a
  | _ ->
      error (Unexpected_annotation loc)

let get_two_annot loc = function
  | [] ->
      ok (None, None)
  | [a] ->
      ok (a, None)
  | [a; b] ->
      ok (a, b)
  | _ ->
      error (Unexpected_annotation loc)

let parse_type_annot : int -> string list -> type_annot option tzresult =
 fun loc annot ->
  parse_annots loc annot >>? classify_annot loc
  >>? fun (vars, types, fields) ->
  error_unexpected_annot loc vars
  >>? fun () ->
  error_unexpected_annot loc fields >>? fun () -> get_one_annot loc types

let parse_type_field_annot :
    int -> string list -> (type_annot option * field_annot option) tzresult =
 fun loc annot ->
  parse_annots loc annot >>? classify_annot loc
  >>? fun (vars, types, fields) ->
  error_unexpected_annot loc vars
  >>? fun () ->
  get_one_annot loc types
  >>? fun t -> get_one_annot loc fields >|? fun f -> (t, f)

let parse_composed_type_annot :
    int ->
    string list ->
    (type_annot option * field_annot option * field_annot option) tzresult =
 fun loc annot ->
  parse_annots loc annot >>? classify_annot loc
  >>? fun (vars, types, fields) ->
  error_unexpected_annot loc vars
  >>? fun () ->
  get_one_annot loc types
  >>? fun t -> get_two_annot loc fields >|? fun (f1, f2) -> (t, f1, f2)

let parse_field_annot : int -> string list -> field_annot option tzresult =
 fun loc annot ->
  parse_annots loc annot >>? classify_annot loc
  >>? fun (vars, types, fields) ->
  error_unexpected_annot loc vars
  >>? fun () ->
  error_unexpected_annot loc types >>? fun () -> get_one_annot loc fields

let extract_field_annot :
    Script.node -> (Script.node * field_annot option) tzresult = function
  | Prim (loc, prim, args, annot) ->
      let rec extract_first acc = function
        | [] ->
            (None, annot)
        | s :: rest ->
            if Compare.Int.(String.length s > 0) && Compare.Char.(s.[0] = '%')
            then (Some s, List.rev_append acc rest)
            else extract_first (s :: acc) rest
      in
      let (field_annot, annot) = extract_first [] annot in
      let field_annot =
        match field_annot with
        | None ->
            None
        | Some field_annot ->
            Some
              (`Field_annot
                (String.sub field_annot 1 (String.length field_annot - 1)))
      in
      ok (Prim (loc, prim, args, annot), field_annot)
  | expr ->
      ok (expr, None)

let check_correct_field :
    field_annot option -> field_annot option -> unit tzresult =
 fun f1 f2 ->
  match (f1, f2) with
  | (None, _) | (_, None) ->
      ok ()
  | (Some (`Field_annot s1), Some (`Field_annot s2)) ->
      if String.equal s1 s2 then ok ()
      else error (Inconsistent_field_annotations ("%" ^ s1, "%" ^ s2))

let parse_var_annot :
    int ->
    ?default:var_annot option ->
    string list ->
    var_annot option tzresult =
 fun loc ?default annot ->
  parse_annots loc annot >>? classify_annot loc
  >>? fun (vars, types, fields) ->
  error_unexpected_annot loc types
  >>? fun () ->
  error_unexpected_annot loc fields
  >>? fun () ->
  get_one_annot loc vars
  >|? function
  | Some _ as a ->
      a
  | None -> (
    match default with Some a -> a | None -> None )

let split_last_dot = function
  | None ->
      (None, None)
  | Some (`Field_annot s) -> (
    match String.rindex_opt s '.' with
    | None ->
        (None, Some (`Field_annot s))
    | Some i ->
        let s1 = String.sub s 0 i in
        let s2 = String.sub s (i + 1) (String.length s - i - 1) in
        let f =
          if Compare.String.equal s2 "car" || Compare.String.equal s2 "cdr"
          then None
          else Some (`Field_annot s2)
        in
        (Some (`Var_annot s1), f) )

let common_prefix v1 v2 =
  match (v1, v2) with
  | (Some (`Var_annot s1), Some (`Var_annot s2))
    when Compare.String.equal s1 s2 ->
      v1
  | (Some _, None) ->
      v1
  | (None, Some _) ->
      v2
  | (_, _) ->
      None

let parse_constr_annot :
    int ->
    ?if_special_first:field_annot option ->
    ?if_special_second:field_annot option ->
    string list ->
    ( var_annot option
    * type_annot option
    * field_annot option
    * field_annot option )
    tzresult =
 fun loc ?if_special_first ?if_special_second annot ->
  parse_annots ~allow_special_field:true loc annot
  >>? classify_annot loc
  >>? fun (vars, types, fields) ->
  get_one_annot loc vars
  >>? fun v ->
  get_one_annot loc types
  >>? fun t ->
  get_two_annot loc fields
  >>? fun (f1, f2) ->
  ( match (if_special_first, f1) with
  | (Some special_var, Some (`Field_annot "@")) ->
      ok (split_last_dot special_var)
  | (None, Some (`Field_annot "@")) ->
      error (Unexpected_annotation loc)
  | (_, _) ->
      ok (v, f1) )
  >>? fun (v1, f1) ->
  ( match (if_special_second, f2) with
  | (Some special_var, Some (`Field_annot "@")) ->
      ok (split_last_dot special_var)
  | (None, Some (`Field_annot "@")) ->
      error (Unexpected_annotation loc)
  | (_, _) ->
      ok (v, f2) )
  >|? fun (v2, f2) ->
  let v = match v with None -> common_prefix v1 v2 | Some _ -> v in
  (v, t, f1, f2)

let parse_two_var_annot :
    int -> string list -> (var_annot option * var_annot option) tzresult =
 fun loc annot ->
  parse_annots loc annot >>? classify_annot loc
  >>? fun (vars, types, fields) ->
  error_unexpected_annot loc types
  >>? fun () ->
  error_unexpected_annot loc fields >>? fun () -> get_two_annot loc vars

let parse_destr_annot :
    int ->
    string list ->
    default_accessor:field_annot option ->
    field_name:field_annot option ->
    pair_annot:var_annot option ->
    value_annot:var_annot option ->
    (var_annot option * field_annot option) tzresult =
 fun loc annot ~default_accessor ~field_name ~pair_annot ~value_annot ->
  parse_annots loc ~allow_special_var:true annot
  >>? classify_annot loc
  >>? fun (vars, types, fields) ->
  error_unexpected_annot loc types
  >>? fun () ->
  get_one_annot loc vars
  >>? fun v ->
  get_one_annot loc fields
  >|? fun f ->
  let default =
    gen_access_annot pair_annot field_name ~default:default_accessor
  in
  let v =
    match v with
    | Some (`Var_annot "%") ->
        field_to_var_annot field_name
    | Some (`Var_annot "%%") ->
        default
    | Some _ ->
        v
    | None ->
        value_annot
  in
  (v, f)

let parse_entrypoint_annot :
    int ->
    ?default:var_annot option ->
    string list ->
    (var_annot option * field_annot option) tzresult =
 fun loc ?default annot ->
  parse_annots loc annot >>? classify_annot loc
  >>? fun (vars, types, fields) ->
  error_unexpected_annot loc types
  >>? fun () ->
  get_one_annot loc fields
  >>? fun f ->
  get_one_annot loc vars
  >|? function
  | Some _ as a ->
      (a, f)
  | None -> (
    match default with Some a -> (a, f) | None -> (None, f) )

let parse_var_type_annot :
    int -> string list -> (var_annot option * type_annot option) tzresult =
 fun loc annot ->
  parse_annots loc annot >>? classify_annot loc
  >>? fun (vars, types, fields) ->
  error_unexpected_annot loc fields
  >>? fun () ->
  get_one_annot loc vars
  >>? fun v -> get_one_annot loc types >|? fun t -> (v, t)

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Import Alpha_context.

Import Micheline.

Import Script_tc_errors.

Import Script_typed_ir.

Definition default_now_annot : option (* `Var_annot *) string :=
  Some
    (* ❌ Variants not supported *)
    variant.

Definition default_amount_annot : option (* `Var_annot *) string :=
  Some
    (* ❌ Variants not supported *)
    variant.

Definition default_balance_annot : option (* `Var_annot *) string :=
  Some
    (* ❌ Variants not supported *)
    variant.

Definition default_steps_annot : option (* `Var_annot *) string :=
  Some
    (* ❌ Variants not supported *)
    variant.

Definition default_source_annot : option (* `Var_annot *) string :=
  Some
    (* ❌ Variants not supported *)
    variant.

Definition default_sender_annot : option (* `Var_annot *) string :=
  Some
    (* ❌ Variants not supported *)
    variant.

Definition default_self_annot : option (* `Var_annot *) string :=
  Some
    (* ❌ Variants not supported *)
    variant.

Definition default_arg_annot : option (* `Var_annot *) string :=
  Some
    (* ❌ Variants not supported *)
    variant.

Definition default_param_annot : option (* `Var_annot *) string :=
  Some
    (* ❌ Variants not supported *)
    variant.

Definition default_storage_annot : option (* `Var_annot *) string :=
  Some
    (* ❌ Variants not supported *)
    variant.

Definition default_car_annot : option (* `Field_annot *) string :=
  Some
    (* ❌ Variants not supported *)
    variant.

Definition default_cdr_annot : option (* `Field_annot *) string :=
  Some
    (* ❌ Variants not supported *)
    variant.

Definition default_contract_annot : option (* `Field_annot *) string :=
  Some
    (* ❌ Variants not supported *)
    variant.

Definition default_addr_annot : option (* `Field_annot *) string :=
  Some
    (* ❌ Variants not supported *)
    variant.

Definition default_manager_annot : option (* `Field_annot *) string :=
  Some
    (* ❌ Variants not supported *)
    variant.

Definition default_pack_annot : option (* `Field_annot *) string :=
  Some
    (* ❌ Variants not supported *)
    variant.

Definition default_unpack_annot : option (* `Field_annot *) string :=
  Some
    (* ❌ Variants not supported *)
    variant.

Definition default_slice_annot : option (* `Field_annot *) string :=
  Some
    (* ❌ Variants not supported *)
    variant.

Definition default_elt_annot : option (* `Field_annot *) string :=
  Some
    (* ❌ Variants not supported *)
    variant.

Definition default_key_annot : option (* `Field_annot *) string :=
  Some
    (* ❌ Variants not supported *)
    variant.

Definition default_hd_annot : option (* `Field_annot *) string :=
  Some
    (* ❌ Variants not supported *)
    variant.

Definition default_tl_annot : option (* `Field_annot *) string :=
  Some
    (* ❌ Variants not supported *)
    variant.

Definition default_some_annot : option (* `Field_annot *) string :=
  Some
    (* ❌ Variants not supported *)
    variant.

Definition default_left_annot : option (* `Field_annot *) string :=
  Some
    (* ❌ Variants not supported *)
    variant.

Definition default_right_annot : option (* `Field_annot *) string :=
  Some
    (* ❌ Variants not supported *)
    variant.

Definition default_binding_annot : option (* `Field_annot *) string :=
  Some
    (* ❌ Variants not supported *)
    variant.

Definition unparse_type_annot
  (function_parameter :
    option Tezos_raw_protocol_alpha.Script_typed_ir.type_annot) : list string :=
  match function_parameter with
  | None => []
  | Some (Type_annot a) => cons (op_caret ":" % string a) []
  end.

Definition unparse_var_annot
  (function_parameter :
    option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot) : list string :=
  match function_parameter with
  | None => []
  | Some (Var_annot a) => cons (op_caret "@" % string a) []
  end.

Definition unparse_field_annot
  (function_parameter :
    option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot)
  : list string :=
  match function_parameter with
  | None => []
  | Some (Field_annot a) => cons (op_caret "%" % string a) []
  end.

Definition field_to_var_annot
  (function_parameter :
    option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot)
  : option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot :=
  match function_parameter with
  | None => None
  | Some (Field_annot s) =>
    Some
      (* ❌ Variants not supported *)
      variant
  end.

Definition type_to_var_annot
  (function_parameter :
    option Tezos_raw_protocol_alpha.Script_typed_ir.type_annot)
  : option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot :=
  match function_parameter with
  | None => None
  | Some (Type_annot s) =>
    Some
      (* ❌ Variants not supported *)
      variant
  end.

Definition var_to_field_annot
  (function_parameter :
    option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot)
  : option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot :=
  match function_parameter with
  | None => None
  | Some (Var_annot s) =>
    Some
      (* ❌ Variants not supported *)
      variant
  end.

Definition default_annot {A : Set}
  (default : option A) (function_parameter : option A) : option A :=
  match function_parameter with
  | None => default
  | annot => annot
  end.

Definition gen_access_annot
  (value_annot : option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot)
  (op_staroptstar :
    option (option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot))
  : option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot ->
  option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot :=
  let default :=
    match op_staroptstar with
    | Some op_starsthstar => op_starsthstar
    | None => None
    end in
  fun field_annot =>
    match (value_annot, field_annot, default) with
    |
      (None, None, _) | (Some _, None, None) |
        (None, Some (Field_annot "" % string), _) => None
    | (None, Some (Field_annot f), _) =>
      Some
        (* ❌ Variants not supported *)
        variant
    |
      (Some (Var_annot v), None | Some (Field_annot "" % string),
        Some (Field_annot f)) =>
      Some
        (* ❌ Variants not supported *)
        variant
    | (Some (Var_annot v), Some (Field_annot f), _) =>
      Some
        (* ❌ Variants not supported *)
        variant
    end.

Definition merge_type_annot
  (legacy : bool)
  (annot1 : option Tezos_raw_protocol_alpha.Script_typed_ir.type_annot)
  (annot2 : option Tezos_raw_protocol_alpha.Script_typed_ir.type_annot)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (option Tezos_raw_protocol_alpha.Script_typed_ir.type_annot) :=
  match (annot1, annot2) with
  | (None, None) | (Some _, None) | (None, Some _) => ok None
  | (Some (Type_annot a1), Some (Type_annot a2)) =>
    if op_pipepipe legacy (String.equal a1 a2) then
      ok annot1
    else
      __error_value
        (Tezos_protocol_environment_alpha__Environment.Error_monad.Inconsistent_annotations
          (op_caret ":" % string a1) (op_caret ":" % string a2))
  end.

Definition merge_field_annot
  (legacy : bool)
  (annot1 : option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot)
  (annot2 : option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot) :=
  match (annot1, annot2) with
  | (None, None) | (Some _, None) | (None, Some _) => ok None
  | (Some (Field_annot a1), Some (Field_annot a2)) =>
    if op_pipepipe legacy (String.equal a1 a2) then
      ok annot1
    else
      __error_value
        (Tezos_protocol_environment_alpha__Environment.Error_monad.Inconsistent_annotations
          (op_caret "%" % string a1) (op_caret "%" % string a2))
  end.

Definition merge_var_annot
  (annot1 : option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot)
  (annot2 : option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot)
  : option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot :=
  match (annot1, annot2) with
  | (None, None) | (Some _, None) | (None, Some _) => None
  | (Some (Var_annot a1), Some (Var_annot a2)) =>
    if String.equal a1 a2 then
      annot1
    else
      None
  end.

Definition error_unexpected_annot {A : Set}
  (loc : Tezos_raw_protocol_alpha.Alpha_context.Script.location)
  (annot : list A)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit :=
  match annot with
  | [] => ok tt
  | cons _ _ =>
    __error_value
      (Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_annotation
        loc)
  end.

Definition fail_unexpected_annot {A : Set}
  (loc : Tezos_raw_protocol_alpha.Alpha_context.Script.location)
  (annot : list A)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
  Lwt.__return (error_unexpected_annot loc annot).

Definition parse_annots
  (loc : Tezos_raw_protocol_alpha.Alpha_context.Script.location)
  (op_staroptstar : option bool)
  : option bool -> list string ->
  Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (list (* `Field_annot *) (option string)) :=
  let allow_special_var :=
    match op_staroptstar with
    | Some op_starsthstar => op_starsthstar
    | None => false
    end in
  fun op_staroptstar =>
    let allow_special_field :=
      match op_staroptstar with
      | Some op_starsthstar => op_starsthstar
      | None => false
      end in
    fun l =>
      let sub_or_wildcard {A : Set}
        (specials : list ascii) (wrap : option string -> A) (s : string) (acc :
        list A)
        : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (list A) :=
        let len := String.length s in
        if op_eq len 1 then
          op_atat ok (cons (wrap None) acc)
        else
          match String.get s 1 with
          |
            "a" % char |
              "b" % char |
                "c" % char |
                  "d" % char |
                    "e" % char |
                      "f" % char |
                        "g" % char |
                          "h" % char |
                            "i" % char |
                              "j" % char |
                                "k" % char |
                                  "l" % char |
                                    "m" % char |
                                      "n" % char |
                                        "o" % char |
                                          "p" % char |
                                            "q" % char |
                                              "r" % char |
                                                "s" % char |
                                                  "t" % char |
                                                    "u" % char |
                                                      "v" % char |
                                                        "w" % char |
                                                          "x" % char |
                                                            "y" % char |
                                                              "z" % char |
              "A" % char |
                "B" % char |
                  "C" % char |
                    "D" % char |
                      "E" % char |
                        "F" % char |
                          "G" % char |
                            "H" % char |
                              "I" % char |
                                "J" % char |
                                  "K" % char |
                                    "L" % char |
                                      "M" % char |
                                        "N" % char |
                                          "O" % char |
                                            "P" % char |
                                              "Q" % char |
                                                "R" % char |
                                                  "S" % char |
                                                    "T" % char |
                                                      "U" % char |
                                                        "V" % char |
                                                          "W" % char |
                                                            "X" % char |
                                                              "Y" % char |
                                                                "Z" % char |
              "_" % char =>
            op_atat ok
              (cons (wrap (Some (String.sub s 1 (op_minus len 1)))) acc)
          | "@" % char => op_atat ok (cons (wrap (Some "@" % string)) acc)
          | "%" % char =>
            if op_eq len 2 then
              op_atat ok (cons (wrap (Some "%" % string)) acc)
            else
              if op_andand (op_eq len 3) (op_eq (String.get s 2) "%" % char)
                then
                op_atat ok (cons (wrap (Some "%%" % string)) acc)
              else
                __error_value
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_annotation
                    loc)
          | _ =>
            __error_value
              (Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_annotation
                loc)
          end in
      op_gtpipequestion
        (List.fold_left
          (fun acc =>
            fun s =>
              op_gtgtquestion acc
                (fun acc =>
                  if op_eq (String.length s) 0 then
                    __error_value
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_annotation
                        loc)
                  else
                    match String.get s 0 with
                    | ":" % char =>
                      sub_or_wildcard []
                        (fun a =>
                          (* ❌ Variants not supported *)
                          variant) s acc
                    | "@" % char =>
                      sub_or_wildcard
                        (if allow_special_var then
                          cons "%" % char []
                        else
                          [])
                        (fun a =>
                          (* ❌ Variants not supported *)
                          variant) s acc
                    | "%" % char =>
                      sub_or_wildcard
                        (if allow_special_field then
                          cons "@" % char []
                        else
                          [])
                        (fun a =>
                          (* ❌ Variants not supported *)
                          variant) s acc
                    | _ =>
                      __error_value
                        (Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_annotation
                          loc)
                    end)) (ok []) l) List.rev.

Definition opt_var_of_var_opt {A : Set}
  (function_parameter : (* `Var_annot *) option A)
  : option (* `Var_annot *) A :=
  match function_parameter with
  | Var_annot None => None
  | Var_annot (Some a) =>
    Some
      (* ❌ Variants not supported *)
      variant
  end.

Definition opt_field_of_field_opt {A : Set}
  (function_parameter : (* `Field_annot *) option A)
  : option (* `Field_annot *) A :=
  match function_parameter with
  | Field_annot None => None
  | Field_annot (Some a) =>
    Some
      (* ❌ Variants not supported *)
      variant
  end.

Definition opt_type_of_type_opt {A : Set}
  (function_parameter : (* `Type_annot *) option A)
  : option (* `Type_annot *) A :=
  match function_parameter with
  | Type_annot None => None
  | Type_annot (Some a) =>
    Some
      (* ❌ Variants not supported *)
      variant
  end.

Definition classify_annot
  (loc : Tezos_raw_protocol_alpha.Alpha_context.Script.location)
  (l : list (* `Var_annot *) (option string))
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (list (option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot) *
      list (option Tezos_raw_protocol_alpha.Script_typed_ir.type_annot) *
      list (option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot)) :=
  (* ❌ Try-with are not handled *)
  try
    (let '(_, rv, _, rt, _, rf) :=
      List.fold_left
        (fun function_parameter =>
          let '(in_v, rv, in_t, rt, in_f, rf) := function_parameter in
          fun a =>
            match (a, in_v, rv, in_t, rt, in_f, rf) with
            |
              ((Var_annot _) as a, true, _, _, _, _, _) |
                ((Var_annot _) as a, false, [], _, _, _, _) =>
              (true, (cons (opt_var_of_var_opt a) rv), false, rt, false, rf)
            |
              ((Type_annot _) as a, _, _, true, _, _, _) |
                ((Type_annot _) as a, _, _, false, [], _, _) =>
              (false, rv, true, (cons (opt_type_of_type_opt a) rt), false, rf)
            |
              ((Field_annot _) as a, _, _, _, _, true, _) |
                ((Field_annot _) as a, _, _, _, _, false, []) =>
              (false, rv, false, rt, true, (cons (opt_field_of_field_opt a) rf))
            | _ => raise Exit
            end) (false, [], false, [], false, []) l in
    ok ((List.rev rv), (List.rev rt), (List.rev rf))).

Definition get_one_annot {A : Set}
  (loc : Tezos_raw_protocol_alpha.Alpha_context.Script.location)
  (function_parameter : list (option A))
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (option A) :=
  match function_parameter with
  | [] => ok None
  | cons a [] => ok a
  | _ =>
    __error_value
      (Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_annotation
        loc)
  end.

Definition get_two_annot {A : Set}
  (loc : Tezos_raw_protocol_alpha.Alpha_context.Script.location)
  (function_parameter : list (option A))
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (option A * option A) :=
  match function_parameter with
  | [] => ok (None, None)
  | cons a [] => ok (a, None)
  | cons a (cons b []) => ok (a, b)
  | _ =>
    __error_value
      (Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_annotation
        loc)
  end.

Definition parse_type_annot (loc : Z) (annot : list string)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (option Tezos_raw_protocol_alpha.Script_typed_ir.type_annot) :=
  op_gtgtquestion
    (op_gtgtquestion (parse_annots loc None None annot) (classify_annot loc))
    (fun function_parameter =>
      let '(vars, types, fields) := function_parameter in
      op_gtgtquestion (error_unexpected_annot loc vars)
        (fun function_parameter =>
          let 'tt := function_parameter in
          op_gtgtquestion (error_unexpected_annot loc fields)
            (fun function_parameter =>
              let 'tt := function_parameter in
              get_one_annot loc types))).

Definition parse_type_field_annot (loc : Z) (annot : list string)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (option Tezos_raw_protocol_alpha.Script_typed_ir.type_annot *
      option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot) :=
  op_gtgtquestion
    (op_gtgtquestion (parse_annots loc None None annot) (classify_annot loc))
    (fun function_parameter =>
      let '(vars, types, fields) := function_parameter in
      op_gtgtquestion (error_unexpected_annot loc vars)
        (fun function_parameter =>
          let 'tt := function_parameter in
          op_gtgtquestion (get_one_annot loc types)
            (fun t =>
              op_gtpipequestion (get_one_annot loc fields) (fun f => (t, f))))).

Definition parse_composed_type_annot (loc : Z) (annot : list string)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (option Tezos_raw_protocol_alpha.Script_typed_ir.type_annot *
      option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot *
      option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot) :=
  op_gtgtquestion
    (op_gtgtquestion (parse_annots loc None None annot) (classify_annot loc))
    (fun function_parameter =>
      let '(vars, types, fields) := function_parameter in
      op_gtgtquestion (error_unexpected_annot loc vars)
        (fun function_parameter =>
          let 'tt := function_parameter in
          op_gtgtquestion (get_one_annot loc types)
            (fun t =>
              op_gtpipequestion (get_two_annot loc fields)
                (fun function_parameter =>
                  let '(f1, f2) := function_parameter in
                  (t, f1, f2))))).

Definition parse_field_annot (loc : Z) (annot : list string)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot) :=
  op_gtgtquestion
    (op_gtgtquestion (parse_annots loc None None annot) (classify_annot loc))
    (fun function_parameter =>
      let '(vars, types, fields) := function_parameter in
      op_gtgtquestion (error_unexpected_annot loc vars)
        (fun function_parameter =>
          let 'tt := function_parameter in
          op_gtgtquestion (error_unexpected_annot loc types)
            (fun function_parameter =>
              let 'tt := function_parameter in
              get_one_annot loc fields))).

Definition extract_field_annot
  (function_parameter : Tezos_raw_protocol_alpha.Alpha_context.Script.node)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (Tezos_raw_protocol_alpha.Alpha_context.Script.node *
      option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot) :=
  match function_parameter with
  |
    Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc prim args
      annot =>
    let fix extract_first (acc : list string) (function_parameter : list string)
      : option string *
        Tezos_protocol_environment_alpha__Environment.Micheline.annot :=
      match function_parameter with
      | [] => (None, annot)
      | cons s rest =>
        if
          op_andand (op_gt (String.length s) 0)
            (op_eq (String.get s 0) "%" % char) then
          ((Some s), (List.rev_append acc rest))
        else
          extract_first (cons s acc) rest
      end in
    let '(field_annot, annot) := extract_first [] annot in
    let field_annot :=
      match field_annot with
      | None => None
      | Some field_annot =>
        Some
          (* ❌ Variants not supported *)
          variant
      end in
    ok
      ((Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc prim
        args annot), field_annot)
  | expr => ok (expr, None)
  end.

Definition check_correct_field
  (f1 : option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot)
  (f2 : option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit :=
  match (f1, f2) with
  | (None, _) | (_, None) => ok tt
  | (Some (Field_annot s1), Some (Field_annot s2)) =>
    if String.equal s1 s2 then
      ok tt
    else
      __error_value
        (Tezos_protocol_environment_alpha__Environment.Error_monad.Inconsistent_field_annotations
          (op_caret "%" % string s1) (op_caret "%" % string s2))
  end.

Definition parse_var_annot
  (loc : Z)
  (default : option (option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot))
  (annot : list string)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot) :=
  op_gtgtquestion
    (op_gtgtquestion (parse_annots loc None None annot) (classify_annot loc))
    (fun function_parameter =>
      let '(vars, types, fields) := function_parameter in
      op_gtgtquestion (error_unexpected_annot loc types)
        (fun function_parameter =>
          let 'tt := function_parameter in
          op_gtgtquestion (error_unexpected_annot loc fields)
            (fun function_parameter =>
              let 'tt := function_parameter in
              op_gtpipequestion (get_one_annot loc vars)
                (fun function_parameter =>
                  match function_parameter with
                  | (Some _) as a => a
                  | None =>
                    match default with
                    | Some a => a
                    | None => None
                    end
                  end)))).

Definition split_last_dot
  (function_parameter : option (* `Field_annot *) string)
  : option (* `Var_annot *) string * option (* `Field_annot *) string :=
  match function_parameter with
  | None => (None, None)
  | Some (Field_annot s) =>
    match String.rindex_opt s "." % char with
    | None =>
      (None,
        (Some
          (* ❌ Variants not supported *)
          variant))
    | Some i =>
      let s1 := String.sub s 0 i in
      let s2 :=
        String.sub s (op_plus i 1) (op_minus (op_minus (String.length s) i) 1)
        in
      let f :=
        if
          op_pipepipe (Compare.String.equal s2 "car" % string)
            (Compare.String.equal s2 "cdr" % string) then
          None
        else
          Some
            (* ❌ Variants not supported *)
            variant in
      ((Some
        (* ❌ Variants not supported *)
        variant), f)
    end
  end.

Definition common_prefix
  (v1 :
    option
      (* `Var_annot *)
      Tezos_protocol_environment_alpha__Environment.Compare.String.t)
  (v2 :
    option
      (* `Var_annot *)
      Tezos_protocol_environment_alpha__Environment.Compare.String.t)
  : option
    (* `Var_annot *)
    Tezos_protocol_environment_alpha__Environment.Compare.String.t :=
  match (v1, v2) with
  | (Some (Var_annot s1), Some (Var_annot s2)) => v1
  | (Some _, None) => v1
  | (None, Some _) => v2
  | (_, _) => None
  end.

Definition parse_constr_annot
  (loc : Z)
  (if_special_first :
    option (option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot))
  (if_special_second :
    option (option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot))
  (annot : list string)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot *
      option Tezos_raw_protocol_alpha.Script_typed_ir.type_annot *
      option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot *
      option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot) :=
  op_gtgtquestion
    (op_gtgtquestion (parse_annots loc None (Some true) annot)
      (classify_annot loc))
    (fun function_parameter =>
      let '(vars, types, fields) := function_parameter in
      op_gtgtquestion (get_one_annot loc vars)
        (fun v =>
          op_gtgtquestion (get_one_annot loc types)
            (fun t =>
              op_gtgtquestion (get_two_annot loc fields)
                (fun function_parameter =>
                  let '(f1, f2) := function_parameter in
                  op_gtgtquestion
                    match (if_special_first, f1) with
                    | (Some special_var, Some (Field_annot "@" % string)) =>
                      ok (split_last_dot special_var)
                    | (None, Some (Field_annot "@" % string)) =>
                      __error_value
                        (Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_annotation
                          loc)
                    | (_, _) => ok (v, f1)
                    end
                    (fun function_parameter =>
                      let '(v1, f1) := function_parameter in
                      op_gtpipequestion
                        match (if_special_second, f2) with
                        | (Some special_var, Some (Field_annot "@" % string)) =>
                          ok (split_last_dot special_var)
                        | (None, Some (Field_annot "@" % string)) =>
                          __error_value
                            (Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_annotation
                              loc)
                        | (_, _) => ok (v, f2)
                        end
                        (fun function_parameter =>
                          let '(v2, f2) := function_parameter in
                          let v :=
                            match v with
                            | None => common_prefix v1 v2
                            | Some _ => v
                            end in
                          (v, t, f1, f2))))))).

Definition parse_two_var_annot (loc : Z) (annot : list string)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot *
      option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot) :=
  op_gtgtquestion
    (op_gtgtquestion (parse_annots loc None None annot) (classify_annot loc))
    (fun function_parameter =>
      let '(vars, types, fields) := function_parameter in
      op_gtgtquestion (error_unexpected_annot loc types)
        (fun function_parameter =>
          let 'tt := function_parameter in
          op_gtgtquestion (error_unexpected_annot loc fields)
            (fun function_parameter =>
              let 'tt := function_parameter in
              get_two_annot loc vars))).

Definition parse_destr_annot
  (loc : Z) (annot : list string)
  (default_accessor :
    option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot)
  (field_name : option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot)
  (pair_annot : option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot)
  (value_annot : option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot *
      option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot) :=
  op_gtgtquestion
    (op_gtgtquestion (parse_annots loc (Some true) None annot)
      (classify_annot loc))
    (fun function_parameter =>
      let '(vars, types, fields) := function_parameter in
      op_gtgtquestion (error_unexpected_annot loc types)
        (fun function_parameter =>
          let 'tt := function_parameter in
          op_gtgtquestion (get_one_annot loc vars)
            (fun v =>
              op_gtpipequestion (get_one_annot loc fields)
                (fun f =>
                  let default :=
                    gen_access_annot pair_annot (Some default_accessor)
                      field_name in
                  let v :=
                    match v with
                    | Some (Var_annot "%" % string) =>
                      field_to_var_annot field_name
                    | Some (Var_annot "%%" % string) => default
                    | Some _ => v
                    | None => value_annot
                    end in
                  (v, f))))).

Definition parse_entrypoint_annot
  (loc : Z)
  (default : option (option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot))
  (annot : list string)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot *
      option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot) :=
  op_gtgtquestion
    (op_gtgtquestion (parse_annots loc None None annot) (classify_annot loc))
    (fun function_parameter =>
      let '(vars, types, fields) := function_parameter in
      op_gtgtquestion (error_unexpected_annot loc types)
        (fun function_parameter =>
          let 'tt := function_parameter in
          op_gtgtquestion (get_one_annot loc fields)
            (fun f =>
              op_gtpipequestion (get_one_annot loc vars)
                (fun function_parameter =>
                  match function_parameter with
                  | (Some _) as a => (a, f)
                  | None =>
                    match default with
                    | Some a => (a, f)
                    | None => (None, f)
                    end
                  end)))).

Definition parse_var_type_annot (loc : Z) (annot : list string)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot *
      option Tezos_raw_protocol_alpha.Script_typed_ir.type_annot) :=
  op_gtgtquestion
    (op_gtgtquestion (parse_annots loc None None annot) (classify_annot loc))
    (fun function_parameter =>
      let '(vars, types, fields) := function_parameter in
      op_gtgtquestion (error_unexpected_annot loc fields)
        (fun function_parameter =>
          let 'tt := function_parameter in
          op_gtgtquestion (get_one_annot loc vars)
            (fun v =>
              op_gtpipequestion (get_one_annot loc types) (fun t => (v, t))))).

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Alpha_context
open Script_typed_ir

(** Default annotations *)

val default_now_annot : var_annot option

val default_amount_annot : var_annot option

val default_balance_annot : var_annot option

val default_steps_annot : var_annot option

val default_source_annot : var_annot option

val default_sender_annot : var_annot option

val default_self_annot : var_annot option

val default_arg_annot : var_annot option

val default_param_annot : var_annot option

val default_storage_annot : var_annot option

val default_car_annot : field_annot option

val default_cdr_annot : field_annot option

val default_contract_annot : field_annot option

val default_addr_annot : field_annot option

val default_manager_annot : field_annot option

val default_pack_annot : field_annot option

val default_unpack_annot : field_annot option

val default_slice_annot : field_annot option

val default_elt_annot : field_annot option

val default_key_annot : field_annot option

val default_hd_annot : field_annot option

val default_tl_annot : field_annot option

val default_some_annot : field_annot option

val default_left_annot : field_annot option

val default_right_annot : field_annot option

val default_binding_annot : field_annot option

(** Unparse annotations to their string representation *)

val unparse_type_annot : type_annot option -> string list

val unparse_var_annot : var_annot option -> string list

val unparse_field_annot : field_annot option -> string list

(** Convertions functions between different annotation kinds *)

val field_to_var_annot : field_annot option -> var_annot option

val type_to_var_annot : type_annot option -> var_annot option

val var_to_field_annot : var_annot option -> field_annot option

(** Replace an annotation by its default value if it is [None] *)
val default_annot : default:'a option -> 'a option -> 'a option

(** Generate annotation for field accesses, of the form [var.field1.field2] *)
val gen_access_annot :
  var_annot option ->
  ?default:field_annot option ->
  field_annot option ->
  var_annot option

(** Merge type annotations.
    @return an error {!Inconsistent_type_annotations} if they are both present
    and different, unless [legacy] *)
val merge_type_annot :
  legacy:bool ->
  type_annot option ->
  type_annot option ->
  type_annot option tzresult

(** Merge field annotations.
    @return an error {!Inconsistent_type_annotations} if they are both present
    and different, unless [legacy] *)
val merge_field_annot :
  legacy:bool ->
  field_annot option ->
  field_annot option ->
  field_annot option tzresult

(** Merge variable annotations, does not fail ([None] if different). *)
val merge_var_annot : var_annot option -> var_annot option -> var_annot option

(** @return an error {!Unexpected_annotation} in the monad the list is not empty. *)
val error_unexpected_annot : int -> 'a list -> unit tzresult

(** Same as {!error_unexpected_annot} in Lwt. *)
val fail_unexpected_annot : int -> 'a list -> unit tzresult Lwt.t

(** Parse a type annotation only. *)
val parse_type_annot : int -> string list -> type_annot option tzresult

(** Parse a field annotation only. *)
val parse_field_annot : int -> string list -> field_annot option tzresult

(** Parse an annotation for composed types, of the form
    [:ty_name %field] in any order. *)
val parse_type_field_annot :
  int -> string list -> (type_annot option * field_annot option) tzresult

(** Parse an annotation for composed types, of the form
    [:ty_name %field1 %field2] in any order. *)
val parse_composed_type_annot :
  int ->
  string list ->
  (type_annot option * field_annot option * field_annot option) tzresult

(** Extract and remove a field annotation from a node *)
val extract_field_annot :
  Script.node -> (Script.node * field_annot option) tzresult

(** Check that field annotations match, used for field accesses. *)
val check_correct_field :
  field_annot option -> field_annot option -> unit tzresult

(** Instruction annotations parsing *)

(** Parse a variable annotation, replaced by a default value if [None]. *)
val parse_var_annot :
  int -> ?default:var_annot option -> string list -> var_annot option tzresult

val parse_constr_annot :
  int ->
  ?if_special_first:field_annot option ->
  ?if_special_second:field_annot option ->
  string list ->
  ( var_annot option
  * type_annot option
  * field_annot option
  * field_annot option )
  tzresult

val parse_two_var_annot :
  int -> string list -> (var_annot option * var_annot option) tzresult

val parse_destr_annot :
  int ->
  string list ->
  default_accessor:field_annot option ->
  field_name:field_annot option ->
  pair_annot:var_annot option ->
  value_annot:var_annot option ->
  (var_annot option * field_annot option) tzresult

val parse_entrypoint_annot :
  int ->
  ?default:var_annot option ->
  string list ->
  (var_annot option * field_annot option) tzresult

val parse_var_type_annot :
  int -> string list -> (var_annot option * type_annot option) tzresult

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Parameter default_now_annot :
  option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot.

Parameter default_amount_annot :
  option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot.

Parameter default_balance_annot :
  option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot.

Parameter default_steps_annot :
  option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot.

Parameter default_source_annot :
  option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot.

Parameter default_sender_annot :
  option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot.

Parameter default_self_annot :
  option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot.

Parameter default_arg_annot :
  option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot.

Parameter default_param_annot :
  option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot.

Parameter default_storage_annot :
  option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot.

Parameter default_car_annot :
  option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot.

Parameter default_cdr_annot :
  option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot.

Parameter default_contract_annot :
  option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot.

Parameter default_addr_annot :
  option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot.

Parameter default_manager_annot :
  option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot.

Parameter default_pack_annot :
  option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot.

Parameter default_unpack_annot :
  option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot.

Parameter default_slice_annot :
  option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot.

Parameter default_elt_annot :
  option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot.

Parameter default_key_annot :
  option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot.

Parameter default_hd_annot :
  option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot.

Parameter default_tl_annot :
  option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot.

Parameter default_some_annot :
  option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot.

Parameter default_left_annot :
  option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot.

Parameter default_right_annot :
  option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot.

Parameter default_binding_annot :
  option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot.

Parameter unparse_type_annot :
  option Tezos_raw_protocol_alpha.Script_typed_ir.type_annot -> list string.

Parameter unparse_var_annot :
  option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot -> list string.

Parameter unparse_field_annot :
  option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot -> list string.

Parameter field_to_var_annot :
  option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot ->
  option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot.

Parameter type_to_var_annot :
  option Tezos_raw_protocol_alpha.Script_typed_ir.type_annot ->
  option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot.

Parameter var_to_field_annot :
  option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot ->
  option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot.

Parameter default_annot : forall {a : Set}, option a -> option a -> option a.

Parameter gen_access_annot :
  option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot ->
  option (option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot) ->
  option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot ->
  option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot.

Parameter merge_type_annot :
  bool -> option Tezos_raw_protocol_alpha.Script_typed_ir.type_annot ->
  option Tezos_raw_protocol_alpha.Script_typed_ir.type_annot ->
  Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (option Tezos_raw_protocol_alpha.Script_typed_ir.type_annot).

Parameter merge_field_annot :
  bool -> option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot ->
  option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot ->
  Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot).

Parameter merge_var_annot :
  option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot ->
  option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot ->
  option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot.

Parameter error_unexpected_annot : forall {a : Set},
  Z -> list a ->
  Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit.

Parameter fail_unexpected_annot : forall {a : Set},
  Z -> list a ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit).

Parameter parse_type_annot :
  Z -> list string ->
  Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (option Tezos_raw_protocol_alpha.Script_typed_ir.type_annot).

Parameter parse_field_annot :
  Z -> list string ->
  Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot).

Parameter parse_type_field_annot :
  Z -> list string ->
  Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (option Tezos_raw_protocol_alpha.Script_typed_ir.type_annot *
      option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot).

Parameter parse_composed_type_annot :
  Z -> list string ->
  Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (option Tezos_raw_protocol_alpha.Script_typed_ir.type_annot *
      option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot *
      option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot).

Parameter extract_field_annot :
  Tezos_raw_protocol_alpha.Alpha_context.Script.node ->
  Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (Tezos_raw_protocol_alpha.Alpha_context.Script.node *
      option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot).

Parameter check_correct_field :
  option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot ->
  option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot ->
  Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit.

Parameter parse_var_annot :
  Z -> option (option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot) ->
  list string ->
  Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot).

Parameter parse_constr_annot :
  Z -> option (option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot) ->
  option (option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot) ->
  list string ->
  Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot *
      option Tezos_raw_protocol_alpha.Script_typed_ir.type_annot *
      option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot *
      option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot).

Parameter parse_two_var_annot :
  Z -> list string ->
  Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot *
      option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot).

Parameter parse_destr_annot :
  Z -> list string ->
  option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot ->
  option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot ->
  option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot ->
  option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot ->
  Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot *
      option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot).

Parameter parse_entrypoint_annot :
  Z -> option (option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot) ->
  list string ->
  Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot *
      option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot).

Parameter parse_var_type_annot :
  Z -> list string ->
  Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot *
      option Tezos_raw_protocol_alpha.Script_typed_ir.type_annot).

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Alpha_context
open Micheline
open Script
open Script_typed_ir
open Script_tc_errors
open Script_ir_annot
module Typecheck_costs = Michelson_v1_gas.Cost_of.Typechecking
module Unparse_costs = Michelson_v1_gas.Cost_of.Unparse

type ex_comparable_ty =
  | Ex_comparable_ty : 'a comparable_ty -> ex_comparable_ty

type ex_ty = Ex_ty : 'a ty -> ex_ty

type ex_stack_ty = Ex_stack_ty : 'a stack_ty -> ex_stack_ty

type tc_context =
  | Lambda : tc_context
  | Dip : 'a stack_ty * tc_context -> tc_context
  | Toplevel : {
      storage_type : 'sto ty;
      param_type : 'param ty;
      root_name : string option;
      legacy_create_contract_literal : bool;
    }
      -> tc_context

type unparsing_mode = Optimized | Readable

type type_logger =
  int ->
  (Script.expr * Script.annot) list ->
  (Script.expr * Script.annot) list ->
  unit

let add_dip ty annot prev =
  match prev with
  | Lambda | Toplevel _ ->
      Dip (Item_t (ty, Empty_t, annot), prev)
  | Dip (stack, _) ->
      Dip (Item_t (ty, stack, annot), prev)

(* ---- Type size accounting ------------------------------------------------*)

let rec comparable_type_size : type t a. (t, a) comparable_struct -> int =
 fun ty ->
  (* No wildcard to force the update when comparable_ty chages. *)
  match ty with
  | Int_key _ ->
      1
  | Nat_key _ ->
      1
  | String_key _ ->
      1
  | Bytes_key _ ->
      1
  | Mutez_key _ ->
      1
  | Bool_key _ ->
      1
  | Key_hash_key _ ->
      1
  | Timestamp_key _ ->
      1
  | Address_key _ ->
      1
  | Pair_key (_, (t, _), _) ->
      1 + comparable_type_size t

let rec type_size : type t. t ty -> int =
 fun ty ->
  match ty with
  | Unit_t _ ->
      1
  | Int_t _ ->
      1
  | Nat_t _ ->
      1
  | Signature_t _ ->
      1
  | Bytes_t _ ->
      1
  | String_t _ ->
      1
  | Mutez_t _ ->
      1
  | Key_hash_t _ ->
      1
  | Key_t _ ->
      1
  | Timestamp_t _ ->
      1
  | Address_t _ ->
      1
  | Bool_t _ ->
      1
  | Operation_t _ ->
      1
  | Pair_t ((l, _, _), (r, _, _), _, _) ->
      1 + type_size l + type_size r
  | Union_t ((l, _), (r, _), _, _) ->
      1 + type_size l + type_size r
  | Lambda_t (arg, ret, _) ->
      1 + type_size arg + type_size ret
  | Option_t (t, _, _) ->
      1 + type_size t
  | List_t (t, _, _) ->
      1 + type_size t
  | Set_t (k, _) ->
      1 + comparable_type_size k
  | Map_t (k, v, _, _) ->
      1 + comparable_type_size k + type_size v
  | Big_map_t (k, v, _) ->
      1 + comparable_type_size k + type_size v
  | Contract_t (arg, _) ->
      1 + type_size arg
  | Chain_id_t _ ->
      1

let rec type_size_of_stack_head : type st. st stack_ty -> up_to:int -> int =
 fun stack ~up_to ->
  match stack with
  | Empty_t ->
      0
  | Item_t (head, tail, _annot) ->
      if Compare.Int.(up_to > 0) then
        Compare.Int.max
          (type_size head)
          (type_size_of_stack_head tail ~up_to:(up_to - 1))
      else 0

(* This is the depth of the stack to inspect for sizes overflow. We
   only need to check the produced types that can be larger than the
   arguments. That's why Swap is 0 for instance as no type grows.
   Constant sized types are not checked: it is assumed they are lower
   than the bound (otherwise every program would be rejected). *)
let number_of_generated_growing_types : type b a. (b, a) instr -> int =
  function
  | Drop ->
      0
  | Dup ->
      0
  | Swap ->
      0
  | Const _ ->
      1
  | Cons_pair ->
      1
  | Car ->
      0
  | Cdr ->
      0
  | Cons_some ->
      1
  | Cons_none _ ->
      1
  | If_none _ ->
      0
  | Left ->
      0
  | Right ->
      0
  | If_left _ ->
      0
  | Cons_list ->
      1
  | Nil ->
      1
  | If_cons _ ->
      0
  | List_map _ ->
      1
  | List_size ->
      0
  | List_iter _ ->
      1
  | Empty_set _ ->
      1
  | Set_iter _ ->
      0
  | Set_mem ->
      0
  | Set_update ->
      0
  | Set_size ->
      0
  | Empty_map _ ->
      1
  | Map_map _ ->
      1
  | Map_iter _ ->
      1
  | Map_mem ->
      0
  | Map_get ->
      0
  | Map_update ->
      0
  | Map_size ->
      0
  | Empty_big_map _ ->
      1
  | Big_map_get ->
      0
  | Big_map_update ->
      0
  | Big_map_mem ->
      0
  | Concat_string ->
      0
  | Concat_string_pair ->
      0
  | Slice_string ->
      0
  | String_size ->
      0
  | Concat_bytes ->
      0
  | Concat_bytes_pair ->
      0
  | Slice_bytes ->
      0
  | Bytes_size ->
      0
  | Add_seconds_to_timestamp ->
      0
  | Add_timestamp_to_seconds ->
      0
  | Sub_timestamp_seconds ->
      0
  | Diff_timestamps ->
      0
  | Add_tez ->
      0
  | Sub_tez ->
      0
  | Mul_teznat ->
      0
  | Mul_nattez ->
      0
  | Ediv_teznat ->
      0
  | Ediv_tez ->
      0
  | Or ->
      0
  | And ->
      0
  | Xor ->
      0
  | Not ->
      0
  | Is_nat ->
      0
  | Neg_nat ->
      0
  | Neg_int ->
      0
  | Abs_int ->
      0
  | Int_nat ->
      0
  | Add_intint ->
      0
  | Add_intnat ->
      0
  | Add_natint ->
      0
  | Add_natnat ->
      0
  | Sub_int ->
      0
  | Mul_intint ->
      0
  | Mul_intnat ->
      0
  | Mul_natint ->
      0
  | Mul_natnat ->
      0
  | Ediv_intint ->
      0
  | Ediv_intnat ->
      0
  | Ediv_natint ->
      0
  | Ediv_natnat ->
      0
  | Lsl_nat ->
      0
  | Lsr_nat ->
      0
  | Or_nat ->
      0
  | And_nat ->
      0
  | And_int_nat ->
      0
  | Xor_nat ->
      0
  | Not_nat ->
      0
  | Not_int ->
      0
  | Seq _ ->
      0
  | If _ ->
      0
  | Loop _ ->
      0
  | Loop_left _ ->
      0
  | Dip _ ->
      0
  | Exec ->
      0
  | Apply _ ->
      0
  | Lambda _ ->
      1
  | Failwith _ ->
      1
  | Nop ->
      0
  | Compare _ ->
      1
  | Eq ->
      0
  | Neq ->
      0
  | Lt ->
      0
  | Gt ->
      0
  | Le ->
      0
  | Ge ->
      0
  | Address ->
      0
  | Contract _ ->
      1
  | Transfer_tokens ->
      1
  | Create_account ->
      0
  | Implicit_account ->
      0
  | Create_contract _ ->
      1
  | Create_contract_2 _ ->
      1
  | Now ->
      0
  | Balance ->
      0
  | Check_signature ->
      0
  | Hash_key ->
      0
  | Blake2b ->
      0
  | Sha256 ->
      0
  | Sha512 ->
      0
  | Steps_to_quota ->
      0
  | Source ->
      0
  | Sender ->
      0
  | Self _ ->
      1
  | Amount ->
      0
  | Set_delegate ->
      0
  | Pack _ ->
      0
  | Unpack _ ->
      1
  | Dig _ ->
      0
  | Dug _ ->
      0
  | Dipn _ ->
      0
  | Dropn _ ->
      0
  | ChainId ->
      0

(* ---- Error helpers -------------------------------------------------------*)

let location = function
  | Prim (loc, _, _, _)
  | Int (loc, _)
  | String (loc, _)
  | Bytes (loc, _)
  | Seq (loc, _) ->
      loc

let kind = function
  | Int _ ->
      Int_kind
  | String _ ->
      String_kind
  | Bytes _ ->
      Bytes_kind
  | Prim _ ->
      Prim_kind
  | Seq _ ->
      Seq_kind

let namespace = function
  | K_parameter | K_storage | K_code ->
      Keyword_namespace
  | D_False
  | D_Elt
  | D_Left
  | D_None
  | D_Pair
  | D_Right
  | D_Some
  | D_True
  | D_Unit ->
      Constant_namespace
  | I_PACK
  | I_UNPACK
  | I_BLAKE2B
  | I_SHA256
  | I_SHA512
  | I_ABS
  | I_ADD
  | I_AMOUNT
  | I_AND
  | I_BALANCE
  | I_CAR
  | I_CDR
  | I_CHAIN_ID
  | I_CHECK_SIGNATURE
  | I_COMPARE
  | I_CONCAT
  | I_CONS
  | I_CREATE_ACCOUNT
  | I_CREATE_CONTRACT
  | I_IMPLICIT_ACCOUNT
  | I_DIP
  | I_DROP
  | I_DUP
  | I_EDIV
  | I_EMPTY_BIG_MAP
  | I_EMPTY_MAP
  | I_EMPTY_SET
  | I_EQ
  | I_EXEC
  | I_APPLY
  | I_FAILWITH
  | I_GE
  | I_GET
  | I_GT
  | I_HASH_KEY
  | I_IF
  | I_IF_CONS
  | I_IF_LEFT
  | I_IF_NONE
  | I_INT
  | I_LAMBDA
  | I_LE
  | I_LEFT
  | I_LOOP
  | I_LSL
  | I_LSR
  | I_LT
  | I_MAP
  | I_MEM
  | I_MUL
  | I_NEG
  | I_NEQ
  | I_NIL
  | I_NONE
  | I_NOT
  | I_NOW
  | I_OR
  | I_PAIR
  | I_PUSH
  | I_RIGHT
  | I_SIZE
  | I_SOME
  | I_SOURCE
  | I_SENDER
  | I_SELF
  | I_SLICE
  | I_STEPS_TO_QUOTA
  | I_SUB
  | I_SWAP
  | I_TRANSFER_TOKENS
  | I_SET_DELEGATE
  | I_UNIT
  | I_UPDATE
  | I_XOR
  | I_ITER
  | I_LOOP_LEFT
  | I_ADDRESS
  | I_CONTRACT
  | I_ISNAT
  | I_CAST
  | I_RENAME
  | I_DIG
  | I_DUG ->
      Instr_namespace
  | T_bool
  | T_contract
  | T_int
  | T_key
  | T_key_hash
  | T_lambda
  | T_list
  | T_map
  | T_big_map
  | T_nat
  | T_option
  | T_or
  | T_pair
  | T_set
  | T_signature
  | T_string
  | T_bytes
  | T_mutez
  | T_timestamp
  | T_unit
  | T_operation
  | T_address
  | T_chain_id ->
      Type_namespace

let unexpected expr exp_kinds exp_ns exp_prims =
  match expr with
  | Int (loc, _) ->
      Invalid_kind (loc, Prim_kind :: exp_kinds, Int_kind)
  | String (loc, _) ->
      Invalid_kind (loc, Prim_kind :: exp_kinds, String_kind)
  | Bytes (loc, _) ->
      Invalid_kind (loc, Prim_kind :: exp_kinds, Bytes_kind)
  | Seq (loc, _) ->
      Invalid_kind (loc, Prim_kind :: exp_kinds, Seq_kind)
  | Prim (loc, name, _, _) -> (
    match (namespace name, exp_ns) with
    | (Type_namespace, Type_namespace)
    | (Instr_namespace, Instr_namespace)
    | (Constant_namespace, Constant_namespace) ->
        Invalid_primitive (loc, exp_prims, name)
    | (ns, _) ->
        Invalid_namespace (loc, name, exp_ns, ns) )

let check_kind kinds expr =
  let kind = kind expr in
  if List.mem kind kinds then return_unit
  else
    let loc = location expr in
    fail (Invalid_kind (loc, kinds, kind))

(* ---- Sets and Maps -------------------------------------------------------*)

let wrap_compare compare a b =
  let res = compare a b in
  if Compare.Int.(res = 0) then 0 else if Compare.Int.(res > 0) then 1 else -1

let rec compare_comparable :
    type a s. (a, s) comparable_struct -> a -> a -> int =
 fun kind ->
  match kind with
  | String_key _ ->
      wrap_compare Compare.String.compare
  | Bool_key _ ->
      wrap_compare Compare.Bool.compare
  | Mutez_key _ ->
      wrap_compare Tez.compare
  | Key_hash_key _ ->
      wrap_compare Signature.Public_key_hash.compare
  | Int_key _ ->
      wrap_compare Script_int.compare
  | Nat_key _ ->
      wrap_compare Script_int.compare
  | Timestamp_key _ ->
      wrap_compare Script_timestamp.compare
  | Address_key _ ->
      wrap_compare
      @@ fun (x, ex) (y, ey) ->
      let lres = Contract.compare x y in
      if Compare.Int.(lres = 0) then Compare.String.compare ex ey else lres
  | Bytes_key _ ->
      wrap_compare MBytes.compare
  | Pair_key ((tl, _), (tr, _), _) ->
      fun (lx, rx) (ly, ry) ->
        let lres = compare_comparable tl lx ly in
        if Compare.Int.(lres = 0) then compare_comparable tr rx ry else lres

let empty_set : type a. a comparable_ty -> a set =
 fun ty ->
  let module OPS = Set.Make (struct
    type t = a

    let compare = compare_comparable ty
  end) in
  ( module struct
    type elt = a

    let elt_ty = ty

    module OPS = OPS

    let boxed = OPS.empty

    let size = 0
  end )

let set_update : type a. a -> bool -> a set -> a set =
 fun v b (module Box) ->
  ( module struct
    type elt = a

    let elt_ty = Box.elt_ty

    module OPS = Box.OPS

    let boxed =
      if b then Box.OPS.add v Box.boxed else Box.OPS.remove v Box.boxed

    let size =
      let mem = Box.OPS.mem v Box.boxed in
      if mem then if b then Box.size else Box.size - 1
      else if b then Box.size + 1
      else Box.size
  end )

let set_mem : type elt. elt -> elt set -> bool =
 fun v (module Box) -> Box.OPS.mem v Box.boxed

let set_fold : type elt acc. (elt -> acc -> acc) -> elt set -> acc -> acc =
 fun f (module Box) -> Box.OPS.fold f Box.boxed

let set_size : type elt. elt set -> Script_int.n Script_int.num =
 fun (module Box) -> Script_int.(abs (of_int Box.size))

let map_key_ty : type a b. (a, b) map -> a comparable_ty =
 fun (module Box) -> Box.key_ty

let empty_map : type a b. a comparable_ty -> (a, b) map =
 fun ty ->
  let module OPS = Map.Make (struct
    type t = a

    let compare = compare_comparable ty
  end) in
  ( module struct
    type key = a

    type value = b

    let key_ty = ty

    module OPS = OPS

    let boxed = (OPS.empty, 0)
  end )

let map_get : type key value. key -> (key, value) map -> value option =
 fun k (module Box) -> Box.OPS.find_opt k (fst Box.boxed)

let map_update : type a b. a -> b option -> (a, b) map -> (a, b) map =
 fun k v (module Box) ->
  ( module struct
    type key = a

    type value = b

    let key_ty = Box.key_ty

    module OPS = Box.OPS

    let boxed =
      let (map, size) = Box.boxed in
      let contains = Box.OPS.mem k map in
      match v with
      | Some v ->
          (Box.OPS.add k v map, size + if contains then 0 else 1)
      | None ->
          (Box.OPS.remove k map, size - if contains then 1 else 0)
  end )

let map_set : type a b. a -> b -> (a, b) map -> (a, b) map =
 fun k v (module Box) ->
  ( module struct
    type key = a

    type value = b

    let key_ty = Box.key_ty

    module OPS = Box.OPS

    let boxed =
      let (map, size) = Box.boxed in
      (Box.OPS.add k v map, if Box.OPS.mem k map then size else size + 1)
  end )

let map_mem : type key value. key -> (key, value) map -> bool =
 fun k (module Box) -> Box.OPS.mem k (fst Box.boxed)

let map_fold :
    type key value acc.
    (key -> value -> acc -> acc) -> (key, value) map -> acc -> acc =
 fun f (module Box) -> Box.OPS.fold f (fst Box.boxed)

let map_size : type key value. (key, value) map -> Script_int.n Script_int.num
    =
 fun (module Box) -> Script_int.(abs (of_int (snd Box.boxed)))

(* ---- Unparsing (Typed IR -> Untyped expressions) of types -----------------*)

let rec ty_of_comparable_ty : type a s. (a, s) comparable_struct -> a ty =
  function
  | Int_key tname ->
      Int_t tname
  | Nat_key tname ->
      Nat_t tname
  | String_key tname ->
      String_t tname
  | Bytes_key tname ->
      Bytes_t tname
  | Mutez_key tname ->
      Mutez_t tname
  | Bool_key tname ->
      Bool_t tname
  | Key_hash_key tname ->
      Key_hash_t tname
  | Timestamp_key tname ->
      Timestamp_t tname
  | Address_key tname ->
      Address_t tname
  | Pair_key ((l, al), (r, ar), tname) ->
      Pair_t
        ( (ty_of_comparable_ty l, al, None),
          (ty_of_comparable_ty r, ar, None),
          tname,
          false )

let rec comparable_ty_of_ty : type a. a ty -> a comparable_ty option = function
  | Int_t tname ->
      Some (Int_key tname)
  | Nat_t tname ->
      Some (Nat_key tname)
  | String_t tname ->
      Some (String_key tname)
  | Bytes_t tname ->
      Some (Bytes_key tname)
  | Mutez_t tname ->
      Some (Mutez_key tname)
  | Bool_t tname ->
      Some (Bool_key tname)
  | Key_hash_t tname ->
      Some (Key_hash_key tname)
  | Timestamp_t tname ->
      Some (Timestamp_key tname)
  | Address_t tname ->
      Some (Address_key tname)
  | Pair_t ((l, al, _), (r, ar, _), pname, _) -> (
    match comparable_ty_of_ty r with
    | None ->
        None
    | Some rty -> (
      match comparable_ty_of_ty l with
      | None ->
          None
      | Some (Pair_key _) ->
          None (* not a comb *)
      | Some (Int_key tname) ->
          Some (Pair_key ((Int_key tname, al), (rty, ar), pname))
      | Some (Nat_key tname) ->
          Some (Pair_key ((Nat_key tname, al), (rty, ar), pname))
      | Some (String_key tname) ->
          Some (Pair_key ((String_key tname, al), (rty, ar), pname))
      | Some (Bytes_key tname) ->
          Some (Pair_key ((Bytes_key tname, al), (rty, ar), pname))
      | Some (Mutez_key tname) ->
          Some (Pair_key ((Mutez_key tname, al), (rty, ar), pname))
      | Some (Bool_key tname) ->
          Some (Pair_key ((Bool_key tname, al), (rty, ar), pname))
      | Some (Key_hash_key tname) ->
          Some (Pair_key ((Key_hash_key tname, al), (rty, ar), pname))
      | Some (Timestamp_key tname) ->
          Some (Pair_key ((Timestamp_key tname, al), (rty, ar), pname))
      | Some (Address_key tname) ->
          Some (Pair_key ((Address_key tname, al), (rty, ar), pname)) ) )
  | _ ->
      None

let add_field_annot a var = function
  | Prim (loc, prim, args, annots) ->
      Prim
        ( loc,
          prim,
          args,
          annots @ unparse_field_annot a @ unparse_var_annot var )
  | expr ->
      expr

let rec unparse_comparable_ty :
    type a s. (a, s) comparable_struct -> Script.node = function
  | Int_key tname ->
      Prim (-1, T_int, [], unparse_type_annot tname)
  | Nat_key tname ->
      Prim (-1, T_nat, [], unparse_type_annot tname)
  | String_key tname ->
      Prim (-1, T_string, [], unparse_type_annot tname)
  | Bytes_key tname ->
      Prim (-1, T_bytes, [], unparse_type_annot tname)
  | Mutez_key tname ->
      Prim (-1, T_mutez, [], unparse_type_annot tname)
  | Bool_key tname ->
      Prim (-1, T_bool, [], unparse_type_annot tname)
  | Key_hash_key tname ->
      Prim (-1, T_key_hash, [], unparse_type_annot tname)
  | Timestamp_key tname ->
      Prim (-1, T_timestamp, [], unparse_type_annot tname)
  | Address_key tname ->
      Prim (-1, T_address, [], unparse_type_annot tname)
  | Pair_key ((l, al), (r, ar), pname) ->
      let tl = add_field_annot al None (unparse_comparable_ty l) in
      let tr = add_field_annot ar None (unparse_comparable_ty r) in
      Prim (-1, T_pair, [tl; tr], unparse_type_annot pname)

let rec unparse_ty_no_lwt :
    type a. context -> a ty -> (Script.node * context) tzresult =
 fun ctxt ty ->
  Gas.consume ctxt Unparse_costs.cycle
  >>? fun ctxt ->
  let return ctxt (name, args, annot) =
    let result = Prim (-1, name, args, annot) in
    Gas.consume ctxt (Unparse_costs.prim_cost (List.length args) annot)
    >>? fun ctxt -> ok (result, ctxt)
  in
  match ty with
  | Unit_t tname ->
      return ctxt (T_unit, [], unparse_type_annot tname)
  | Int_t tname ->
      return ctxt (T_int, [], unparse_type_annot tname)
  | Nat_t tname ->
      return ctxt (T_nat, [], unparse_type_annot tname)
  | String_t tname ->
      return ctxt (T_string, [], unparse_type_annot tname)
  | Bytes_t tname ->
      return ctxt (T_bytes, [], unparse_type_annot tname)
  | Mutez_t tname ->
      return ctxt (T_mutez, [], unparse_type_annot tname)
  | Bool_t tname ->
      return ctxt (T_bool, [], unparse_type_annot tname)
  | Key_hash_t tname ->
      return ctxt (T_key_hash, [], unparse_type_annot tname)
  | Key_t tname ->
      return ctxt (T_key, [], unparse_type_annot tname)
  | Timestamp_t tname ->
      return ctxt (T_timestamp, [], unparse_type_annot tname)
  | Address_t tname ->
      return ctxt (T_address, [], unparse_type_annot tname)
  | Signature_t tname ->
      return ctxt (T_signature, [], unparse_type_annot tname)
  | Operation_t tname ->
      return ctxt (T_operation, [], unparse_type_annot tname)
  | Chain_id_t tname ->
      return ctxt (T_chain_id, [], unparse_type_annot tname)
  | Contract_t (ut, tname) ->
      unparse_ty_no_lwt ctxt ut
      >>? fun (t, ctxt) ->
      return ctxt (T_contract, [t], unparse_type_annot tname)
  | Pair_t ((utl, l_field, l_var), (utr, r_field, r_var), tname, _) ->
      let annot = unparse_type_annot tname in
      unparse_ty_no_lwt ctxt utl
      >>? fun (utl, ctxt) ->
      let tl = add_field_annot l_field l_var utl in
      unparse_ty_no_lwt ctxt utr
      >>? fun (utr, ctxt) ->
      let tr = add_field_annot r_field r_var utr in
      return ctxt (T_pair, [tl; tr], annot)
  | Union_t ((utl, l_field), (utr, r_field), tname, _) ->
      let annot = unparse_type_annot tname in
      unparse_ty_no_lwt ctxt utl
      >>? fun (utl, ctxt) ->
      let tl = add_field_annot l_field None utl in
      unparse_ty_no_lwt ctxt utr
      >>? fun (utr, ctxt) ->
      let tr = add_field_annot r_field None utr in
      return ctxt (T_or, [tl; tr], annot)
  | Lambda_t (uta, utr, tname) ->
      unparse_ty_no_lwt ctxt uta
      >>? fun (ta, ctxt) ->
      unparse_ty_no_lwt ctxt utr
      >>? fun (tr, ctxt) ->
      return ctxt (T_lambda, [ta; tr], unparse_type_annot tname)
  | Option_t (ut, tname, _) ->
      let annot = unparse_type_annot tname in
      unparse_ty_no_lwt ctxt ut
      >>? fun (ut, ctxt) -> return ctxt (T_option, [ut], annot)
  | List_t (ut, tname, _) ->
      unparse_ty_no_lwt ctxt ut
      >>? fun (t, ctxt) -> return ctxt (T_list, [t], unparse_type_annot tname)
  | Set_t (ut, tname) ->
      let t = unparse_comparable_ty ut in
      return ctxt (T_set, [t], unparse_type_annot tname)
  | Map_t (uta, utr, tname, _) ->
      let ta = unparse_comparable_ty uta in
      unparse_ty_no_lwt ctxt utr
      >>? fun (tr, ctxt) ->
      return ctxt (T_map, [ta; tr], unparse_type_annot tname)
  | Big_map_t (uta, utr, tname) ->
      let ta = unparse_comparable_ty uta in
      unparse_ty_no_lwt ctxt utr
      >>? fun (tr, ctxt) ->
      return ctxt (T_big_map, [ta; tr], unparse_type_annot tname)

let unparse_ty ctxt ty = Lwt.return (unparse_ty_no_lwt ctxt ty)

let rec strip_var_annots = function
  | (Int _ | String _ | Bytes _) as atom ->
      atom
  | Seq (loc, args) ->
      Seq (loc, List.map strip_var_annots args)
  | Prim (loc, name, args, annots) ->
      let not_var_annot s = Compare.Char.(s.[0] <> '@') in
      let annots = List.filter not_var_annot annots in
      Prim (loc, name, List.map strip_var_annots args, annots)

let serialize_ty_for_error ctxt ty =
  unparse_ty_no_lwt ctxt ty
  |> record_trace Cannot_serialize_error
  >|? fun (ty, ctxt) -> (strip_locations (strip_var_annots ty), ctxt)

let rec unparse_stack :
    type a.
    context ->
    a stack_ty ->
    ((Script.expr * Script.annot) list * context) tzresult Lwt.t =
 fun ctxt -> function
  | Empty_t ->
      return ([], ctxt)
  | Item_t (ty, rest, annot) ->
      unparse_ty ctxt ty
      >>=? fun (uty, ctxt) ->
      unparse_stack ctxt rest
      >>=? fun (urest, ctxt) ->
      return ((strip_locations uty, unparse_var_annot annot) :: urest, ctxt)

let serialize_stack_for_error ctxt stack_ty =
  trace Cannot_serialize_error (unparse_stack ctxt stack_ty)

let name_of_ty : type a. a ty -> type_annot option = function
  | Unit_t tname ->
      tname
  | Int_t tname ->
      tname
  | Nat_t tname ->
      tname
  | String_t tname ->
      tname
  | Bytes_t tname ->
      tname
  | Mutez_t tname ->
      tname
  | Bool_t tname ->
      tname
  | Key_hash_t tname ->
      tname
  | Key_t tname ->
      tname
  | Timestamp_t tname ->
      tname
  | Address_t tname ->
      tname
  | Signature_t tname ->
      tname
  | Operation_t tname ->
      tname
  | Chain_id_t tname ->
      tname
  | Contract_t (_, tname) ->
      tname
  | Pair_t (_, _, tname, _) ->
      tname
  | Union_t (_, _, tname, _) ->
      tname
  | Lambda_t (_, _, tname) ->
      tname
  | Option_t (_, tname, _) ->
      tname
  | List_t (_, tname, _) ->
      tname
  | Set_t (_, tname) ->
      tname
  | Map_t (_, _, tname, _) ->
      tname
  | Big_map_t (_, _, tname) ->
      tname

(* ---- Equality witnesses --------------------------------------------------*)

type ('ta, 'tb) eq = Eq : ('same, 'same) eq

let comparable_ty_eq :
    type ta tb.
    context ->
    ta comparable_ty ->
    tb comparable_ty ->
    (ta comparable_ty, tb comparable_ty) eq tzresult =
 fun ctxt ta tb ->
  match (ta, tb) with
  | (Int_key _, Int_key _) ->
      Ok Eq
  | (Nat_key _, Nat_key _) ->
      Ok Eq
  | (String_key _, String_key _) ->
      Ok Eq
  | (Bytes_key _, Bytes_key _) ->
      Ok Eq
  | (Mutez_key _, Mutez_key _) ->
      Ok Eq
  | (Bool_key _, Bool_key _) ->
      Ok Eq
  | (Key_hash_key _, Key_hash_key _) ->
      Ok Eq
  | (Timestamp_key _, Timestamp_key _) ->
      Ok Eq
  | (Address_key _, Address_key _) ->
      Ok Eq
  | (_, _) ->
      serialize_ty_for_error ctxt (ty_of_comparable_ty ta)
      >>? fun (ta, ctxt) ->
      serialize_ty_for_error ctxt (ty_of_comparable_ty tb)
      >>? fun (tb, _ctxt) -> error (Inconsistent_types (ta, tb))

let record_inconsistent ctxt ta tb =
  record_trace_eval (fun () ->
      serialize_ty_for_error ctxt ta
      >>? fun (ta, ctxt) ->
      serialize_ty_for_error ctxt tb
      >|? fun (tb, _ctxt) -> Inconsistent_types (ta, tb))

let record_inconsistent_type_annotations ctxt loc ta tb =
  record_trace_eval (fun () ->
      serialize_ty_for_error ctxt ta
      >>? fun (ta, ctxt) ->
      serialize_ty_for_error ctxt tb
      >|? fun (tb, _ctxt) -> Inconsistent_type_annotations (loc, ta, tb))

let rec ty_eq :
    type ta tb.
    context -> ta ty -> tb ty -> ((ta ty, tb ty) eq * context) tzresult =
 fun ctxt ta tb ->
  let ok (eq : (ta ty, tb ty) eq) ctxt nb_args :
      ((ta ty, tb ty) eq * context) tzresult =
    Gas.consume ctxt (Typecheck_costs.type_ (2 * nb_args))
    >>? fun ctxt -> Ok (eq, ctxt)
  in
  Gas.consume ctxt Typecheck_costs.cycle
  >>? fun ctxt ->
  match (ta, tb) with
  | (Unit_t _, Unit_t _) ->
      ok Eq ctxt 0
  | (Int_t _, Int_t _) ->
      ok Eq ctxt 0
  | (Nat_t _, Nat_t _) ->
      ok Eq ctxt 0
  | (Key_t _, Key_t _) ->
      ok Eq ctxt 0
  | (Key_hash_t _, Key_hash_t _) ->
      ok Eq ctxt 0
  | (String_t _, String_t _) ->
      ok Eq ctxt 0
  | (Bytes_t _, Bytes_t _) ->
      ok Eq ctxt 0
  | (Signature_t _, Signature_t _) ->
      ok Eq ctxt 0
  | (Mutez_t _, Mutez_t _) ->
      ok Eq ctxt 0
  | (Timestamp_t _, Timestamp_t _) ->
      ok Eq ctxt 0
  | (Chain_id_t _, Chain_id_t _) ->
      ok Eq ctxt 0
  | (Address_t _, Address_t _) ->
      ok Eq ctxt 0
  | (Bool_t _, Bool_t _) ->
      ok Eq ctxt 0
  | (Operation_t _, Operation_t _) ->
      ok Eq ctxt 0
  | (Map_t (tal, tar, _, _), Map_t (tbl, tbr, _, _)) ->
      comparable_ty_eq ctxt tal tbl
      >>? (fun Eq -> ty_eq ctxt tar tbr >>? fun (Eq, ctxt) -> ok Eq ctxt 2)
      |> record_inconsistent ctxt ta tb
  | (Big_map_t (tal, tar, _), Big_map_t (tbl, tbr, _)) ->
      comparable_ty_eq ctxt tal tbl
      >>? (fun Eq -> ty_eq ctxt tar tbr >>? fun (Eq, ctxt) -> ok Eq ctxt 2)
      |> record_inconsistent ctxt ta tb
  | (Set_t (ea, _), Set_t (eb, _)) ->
      comparable_ty_eq ctxt ea eb
      >>? (fun Eq -> ok Eq ctxt 1)
      |> record_inconsistent ctxt ta tb
  | ( Pair_t ((tal, _, _), (tar, _, _), _, _),
      Pair_t ((tbl, _, _), (tbr, _, _), _, _) ) ->
      ty_eq ctxt tal tbl
      >>? (fun (Eq, ctxt) ->
            ty_eq ctxt tar tbr >>? fun (Eq, ctxt) -> ok Eq ctxt 2)
      |> record_inconsistent ctxt ta tb
  | (Union_t ((tal, _), (tar, _), _, _), Union_t ((tbl, _), (tbr, _), _, _)) ->
      ty_eq ctxt tal tbl
      >>? (fun (Eq, ctxt) ->
            ty_eq ctxt tar tbr >>? fun (Eq, ctxt) -> ok Eq ctxt 2)
      |> record_inconsistent ctxt ta tb
  | (Lambda_t (tal, tar, _), Lambda_t (tbl, tbr, _)) ->
      ty_eq ctxt tal tbl
      >>? (fun (Eq, ctxt) ->
            ty_eq ctxt tar tbr >>? fun (Eq, ctxt) -> ok Eq ctxt 2)
      |> record_inconsistent ctxt ta tb
  | (Contract_t (tal, _), Contract_t (tbl, _)) ->
      ty_eq ctxt tal tbl
      >>? (fun (Eq, ctxt) -> ok Eq ctxt 1)
      |> record_inconsistent ctxt ta tb
  | (Option_t (tva, _, _), Option_t (tvb, _, _)) ->
      ty_eq ctxt tva tvb
      >>? (fun (Eq, ctxt) -> ok Eq ctxt 1)
      |> record_inconsistent ctxt ta tb
  | (List_t (tva, _, _), List_t (tvb, _, _)) ->
      ty_eq ctxt tva tvb
      >>? (fun (Eq, ctxt) -> ok Eq ctxt 1)
      |> record_inconsistent ctxt ta tb
  | (_, _) ->
      serialize_ty_for_error ctxt ta
      >>? fun (ta, ctxt) ->
      serialize_ty_for_error ctxt tb
      >>? fun (tb, _ctxt) -> error (Inconsistent_types (ta, tb))

let rec stack_ty_eq :
    type ta tb.
    context ->
    int ->
    ta stack_ty ->
    tb stack_ty ->
    ((ta stack_ty, tb stack_ty) eq * context) tzresult =
 fun ctxt lvl ta tb ->
  match (ta, tb) with
  | (Item_t (tva, ra, _), Item_t (tvb, rb, _)) ->
      ty_eq ctxt tva tvb
      |> record_trace (Bad_stack_item lvl)
      >>? fun (Eq, ctxt) ->
      stack_ty_eq ctxt (lvl + 1) ra rb
      >>? fun (Eq, ctxt) ->
      (Ok (Eq, ctxt) : ((ta stack_ty, tb stack_ty) eq * context) tzresult)
  | (Empty_t, Empty_t) ->
      Ok (Eq, ctxt)
  | (_, _) ->
      error Bad_stack_length

let merge_comparable_types :
    type ta.
    legacy:bool ->
    ta comparable_ty ->
    ta comparable_ty ->
    ta comparable_ty tzresult =
 fun ~legacy ta tb ->
  match (ta, tb) with
  | (Int_key annot_a, Int_key annot_b) ->
      merge_type_annot ~legacy annot_a annot_b >|? fun annot -> Int_key annot
  | (Nat_key annot_a, Nat_key annot_b) ->
      merge_type_annot ~legacy annot_a annot_b >|? fun annot -> Nat_key annot
  | (String_key annot_a, String_key annot_b) ->
      merge_type_annot ~legacy annot_a annot_b
      >|? fun annot -> String_key annot
  | (Bytes_key annot_a, Bytes_key annot_b) ->
      merge_type_annot ~legacy annot_a annot_b >|? fun annot -> Bytes_key annot
  | (Mutez_key annot_a, Mutez_key annot_b) ->
      merge_type_annot ~legacy annot_a annot_b >|? fun annot -> Mutez_key annot
  | (Bool_key annot_a, Bool_key annot_b) ->
      merge_type_annot ~legacy annot_a annot_b >|? fun annot -> Bool_key annot
  | (Key_hash_key annot_a, Key_hash_key annot_b) ->
      merge_type_annot ~legacy annot_a annot_b
      >|? fun annot -> Key_hash_key annot
  | (Timestamp_key annot_a, Timestamp_key annot_b) ->
      merge_type_annot ~legacy annot_a annot_b
      >|? fun annot -> Timestamp_key annot
  | (Address_key annot_a, Address_key annot_b) ->
      merge_type_annot ~legacy annot_a annot_b
      >|? fun annot -> Address_key annot
  | (_, _) ->
      assert false

(* FIXME: fix injectivity of some types *)

let merge_types :
    type b.
    legacy:bool ->
    context ->
    Script.location ->
    b ty ->
    b ty ->
    (b ty * context) tzresult =
 fun ~legacy ->
  let rec help : type a. context -> a ty -> a ty -> (a ty * context) tzresult =
   fun ctxt ty1 ty2 ->
    match (ty1, ty2) with
    | (Unit_t tn1, Unit_t tn2) ->
        merge_type_annot ~legacy tn1 tn2 >|? fun tname -> (Unit_t tname, ctxt)
    | (Int_t tn1, Int_t tn2) ->
        merge_type_annot ~legacy tn1 tn2 >|? fun tname -> (Int_t tname, ctxt)
    | (Nat_t tn1, Nat_t tn2) ->
        merge_type_annot ~legacy tn1 tn2 >|? fun tname -> (Nat_t tname, ctxt)
    | (Key_t tn1, Key_t tn2) ->
        merge_type_annot ~legacy tn1 tn2 >|? fun tname -> (Key_t tname, ctxt)
    | (Key_hash_t tn1, Key_hash_t tn2) ->
        merge_type_annot ~legacy tn1 tn2
        >|? fun tname -> (Key_hash_t tname, ctxt)
    | (String_t tn1, String_t tn2) ->
        merge_type_annot ~legacy tn1 tn2 >|? fun tname -> (String_t tname, ctxt)
    | (Bytes_t tn1, Bytes_t tn2) ->
        merge_type_annot ~legacy tn1 tn2 >|? fun tname -> (Bytes_t tname, ctxt)
    | (Signature_t tn1, Signature_t tn2) ->
        merge_type_annot ~legacy tn1 tn2
        >|? fun tname -> (Signature_t tname, ctxt)
    | (Mutez_t tn1, Mutez_t tn2) ->
        merge_type_annot ~legacy tn1 tn2 >|? fun tname -> (Mutez_t tname, ctxt)
    | (Timestamp_t tn1, Timestamp_t tn2) ->
        merge_type_annot ~legacy tn1 tn2
        >|? fun tname -> (Timestamp_t tname, ctxt)
    | (Address_t tn1, Address_t tn2) ->
        merge_type_annot ~legacy tn1 tn2
        >|? fun tname -> (Address_t tname, ctxt)
    | (Bool_t tn1, Bool_t tn2) ->
        merge_type_annot ~legacy tn1 tn2 >|? fun tname -> (Bool_t tname, ctxt)
    | (Chain_id_t tn1, Chain_id_t tn2) ->
        merge_type_annot ~legacy tn1 tn2
        >|? fun tname -> (Chain_id_t tname, ctxt)
    | (Operation_t tn1, Operation_t tn2) ->
        merge_type_annot ~legacy tn1 tn2
        >|? fun tname -> (Operation_t tname, ctxt)
    | (Map_t (tal, tar, tn1, has_big_map), Map_t (tbl, tbr, tn2, _)) ->
        merge_type_annot ~legacy tn1 tn2
        >>? fun tname ->
        help ctxt tar tbr
        >>? fun (value, ctxt) ->
        ty_eq ctxt tar value
        >>? fun (Eq, ctxt) ->
        merge_comparable_types ~legacy tal tbl
        >|? fun tk -> (Map_t (tk, value, tname, has_big_map), ctxt)
    | (Big_map_t (tal, tar, tn1), Big_map_t (tbl, tbr, tn2)) ->
        merge_type_annot ~legacy tn1 tn2
        >>? fun tname ->
        help ctxt tar tbr
        >>? fun (value, ctxt) ->
        ty_eq ctxt tar value
        >>? fun (Eq, ctxt) ->
        merge_comparable_types ~legacy tal tbl
        >|? fun tk -> (Big_map_t (tk, value, tname), ctxt)
    | (Set_t (ea, tn1), Set_t (eb, tn2)) ->
        merge_type_annot ~legacy tn1 tn2
        >>? fun tname ->
        merge_comparable_types ~legacy ea eb
        >|? fun e -> (Set_t (e, tname), ctxt)
    | ( Pair_t
          ((tal, l_field1, l_var1), (tar, r_field1, r_var1), tn1, has_big_map),
        Pair_t ((tbl, l_field2, l_var2), (tbr, r_field2, r_var2), tn2, _) ) ->
        merge_type_annot ~legacy tn1 tn2
        >>? fun tname ->
        merge_field_annot ~legacy l_field1 l_field2
        >>? fun l_field ->
        merge_field_annot ~legacy r_field1 r_field2
        >>? fun r_field ->
        let l_var = merge_var_annot l_var1 l_var2 in
        let r_var = merge_var_annot r_var1 r_var2 in
        help ctxt tal tbl
        >>? fun (left_ty, ctxt) ->
        help ctxt tar tbr
        >|? fun (right_ty, ctxt) ->
        ( Pair_t
            ( (left_ty, l_field, l_var),
              (right_ty, r_field, r_var),
              tname,
              has_big_map ),
          ctxt )
    | ( Union_t ((tal, tal_annot), (tar, tar_annot), tn1, has_big_map),
        Union_t ((tbl, tbl_annot), (tbr, tbr_annot), tn2, _) ) ->
        merge_type_annot ~legacy tn1 tn2
        >>? fun tname ->
        merge_field_annot ~legacy tal_annot tbl_annot
        >>? fun left_annot ->
        merge_field_annot ~legacy tar_annot tbr_annot
        >>? fun right_annot ->
        help ctxt tal tbl
        >>? fun (left_ty, ctxt) ->
        help ctxt tar tbr
        >|? fun (right_ty, ctxt) ->
        ( Union_t
            ((left_ty, left_annot), (right_ty, right_annot), tname, has_big_map),
          ctxt )
    | (Lambda_t (tal, tar, tn1), Lambda_t (tbl, tbr, tn2)) ->
        merge_type_annot ~legacy tn1 tn2
        >>? fun tname ->
        help ctxt tal tbl
        >>? fun (left_ty, ctxt) ->
        help ctxt tar tbr
        >|? fun (right_ty, ctxt) -> (Lambda_t (left_ty, right_ty, tname), ctxt)
    | (Contract_t (tal, tn1), Contract_t (tbl, tn2)) ->
        merge_type_annot ~legacy tn1 tn2
        >>? fun tname ->
        help ctxt tal tbl
        >|? fun (arg_ty, ctxt) -> (Contract_t (arg_ty, tname), ctxt)
    | (Option_t (tva, tn1, has_big_map), Option_t (tvb, tn2, _)) ->
        merge_type_annot ~legacy tn1 tn2
        >>? fun tname ->
        help ctxt tva tvb
        >|? fun (ty, ctxt) -> (Option_t (ty, tname, has_big_map), ctxt)
    | (List_t (tva, tn1, has_big_map), List_t (tvb, tn2, _)) ->
        merge_type_annot ~legacy tn1 tn2
        >>? fun tname ->
        help ctxt tva tvb
        >|? fun (ty, ctxt) -> (List_t (ty, tname, has_big_map), ctxt)
    | (_, _) ->
        assert false
  in
  fun ctxt loc ty1 ty2 ->
    record_inconsistent_type_annotations ctxt loc ty1 ty2 (help ctxt ty1 ty2)

let merge_stacks :
    type ta.
    legacy:bool ->
    Script.location ->
    context ->
    ta stack_ty ->
    ta stack_ty ->
    (ta stack_ty * context) tzresult =
 fun ~legacy loc ->
  let rec help :
      type a.
      context -> a stack_ty -> a stack_ty -> (a stack_ty * context) tzresult =
   fun ctxt stack1 stack2 ->
    match (stack1, stack2) with
    | (Empty_t, Empty_t) ->
        ok (Empty_t, ctxt)
    | (Item_t (ty1, rest1, annot1), Item_t (ty2, rest2, annot2)) ->
        let annot = merge_var_annot annot1 annot2 in
        merge_types ~legacy ctxt loc ty1 ty2
        >>? fun (ty, ctxt) ->
        help ctxt rest1 rest2
        >|? fun (rest, ctxt) -> (Item_t (ty, rest, annot), ctxt)
  in
  help

let has_big_map : type t. t ty -> bool = function
  | Unit_t _ ->
      false
  | Int_t _ ->
      false
  | Nat_t _ ->
      false
  | Signature_t _ ->
      false
  | String_t _ ->
      false
  | Bytes_t _ ->
      false
  | Mutez_t _ ->
      false
  | Key_hash_t _ ->
      false
  | Key_t _ ->
      false
  | Timestamp_t _ ->
      false
  | Address_t _ ->
      false
  | Bool_t _ ->
      false
  | Lambda_t (_, _, _) ->
      false
  | Set_t (_, _) ->
      false
  | Big_map_t (_, _, _) ->
      true
  | Contract_t (_, _) ->
      false
  | Operation_t _ ->
      false
  | Chain_id_t _ ->
      false
  | Pair_t (_, _, _, has_big_map) ->
      has_big_map
  | Union_t (_, _, _, has_big_map) ->
      has_big_map
  | Option_t (_, _, has_big_map) ->
      has_big_map
  | List_t (_, _, has_big_map) ->
      has_big_map
  | Map_t (_, _, _, has_big_map) ->
      has_big_map

(* ---- Type checker results -------------------------------------------------*)

type 'bef judgement =
  | Typed : ('bef, 'aft) descr -> 'bef judgement
  | Failed : {
      descr : 'aft. 'aft stack_ty -> ('bef, 'aft) descr;
    }
      -> 'bef judgement

(* ---- Type checker (Untyped expressions -> Typed IR) ----------------------*)

type ('t, 'f, 'b) branch = {
  branch : 'r. ('t, 'r) descr -> ('f, 'r) descr -> ('b, 'r) descr;
}
[@@unboxed]

let merge_branches :
    type bef a b.
    legacy:bool ->
    context ->
    int ->
    a judgement ->
    b judgement ->
    (a, b, bef) branch ->
    (bef judgement * context) tzresult Lwt.t =
 fun ~legacy ctxt loc btr bfr {branch} ->
  match (btr, bfr) with
  | (Typed ({aft = aftbt; _} as dbt), Typed ({aft = aftbf; _} as dbf)) ->
      let unmatched_branches () =
        serialize_stack_for_error ctxt aftbt
        >>=? fun (aftbt, ctxt) ->
        serialize_stack_for_error ctxt aftbf
        >>|? fun (aftbf, _ctxt) -> Unmatched_branches (loc, aftbt, aftbf)
      in
      trace_eval
        unmatched_branches
        ( Lwt.return (stack_ty_eq ctxt 1 aftbt aftbf)
        >>=? fun (Eq, ctxt) ->
        Lwt.return (merge_stacks ~legacy loc ctxt aftbt aftbf)
        >>=? fun (merged_stack, ctxt) ->
        return
          ( Typed
              (branch
                 {dbt with aft = merged_stack}
                 {dbf with aft = merged_stack}),
            ctxt ) )
  | (Failed {descr = descrt}, Failed {descr = descrf}) ->
      let descr ret = branch (descrt ret) (descrf ret) in
      return (Failed {descr}, ctxt)
  | (Typed dbt, Failed {descr = descrf}) ->
      return (Typed (branch dbt (descrf dbt.aft)), ctxt)
  | (Failed {descr = descrt}, Typed dbf) ->
      return (Typed (branch (descrt dbf.aft) dbf), ctxt)

let rec parse_comparable_ty :
    context -> Script.node -> (ex_comparable_ty * context) tzresult =
 fun ctxt ty ->
  Gas.consume ctxt Typecheck_costs.cycle
  >>? fun ctxt ->
  Gas.consume ctxt (Typecheck_costs.type_ 0)
  >>? fun ctxt ->
  match ty with
  | Prim (loc, T_int, [], annot) ->
      parse_type_annot loc annot
      >|? fun tname -> (Ex_comparable_ty (Int_key tname), ctxt)
  | Prim (loc, T_nat, [], annot) ->
      parse_type_annot loc annot
      >|? fun tname -> (Ex_comparable_ty (Nat_key tname), ctxt)
  | Prim (loc, T_string, [], annot) ->
      parse_type_annot loc annot
      >|? fun tname -> (Ex_comparable_ty (String_key tname), ctxt)
  | Prim (loc, T_bytes, [], annot) ->
      parse_type_annot loc annot
      >|? fun tname -> (Ex_comparable_ty (Bytes_key tname), ctxt)
  | Prim (loc, T_mutez, [], annot) ->
      parse_type_annot loc annot
      >|? fun tname -> (Ex_comparable_ty (Mutez_key tname), ctxt)
  | Prim (loc, T_bool, [], annot) ->
      parse_type_annot loc annot
      >|? fun tname -> (Ex_comparable_ty (Bool_key tname), ctxt)
  | Prim (loc, T_key_hash, [], annot) ->
      parse_type_annot loc annot
      >|? fun tname -> (Ex_comparable_ty (Key_hash_key tname), ctxt)
  | Prim (loc, T_timestamp, [], annot) ->
      parse_type_annot loc annot
      >|? fun tname -> (Ex_comparable_ty (Timestamp_key tname), ctxt)
  | Prim (loc, T_address, [], annot) ->
      parse_type_annot loc annot
      >|? fun tname -> (Ex_comparable_ty (Address_key tname), ctxt)
  | Prim
      ( loc,
        ( ( T_int
          | T_nat
          | T_string
          | T_mutez
          | T_bool
          | T_key
          | T_address
          | T_timestamp ) as prim ),
        l,
        _ ) ->
      error (Invalid_arity (loc, prim, 0, List.length l))
  | Prim
      ( loc,
        ( T_pair
        | T_or
        | T_set
        | T_map
        | T_list
        | T_option
        | T_lambda
        | T_unit
        | T_signature
        | T_contract ),
        _,
        _ ) ->
      error (Comparable_type_expected (loc, Micheline.strip_locations ty))
  | expr ->
      error
      @@ unexpected
           expr
           []
           Type_namespace
           [ T_int;
             T_nat;
             T_string;
             T_mutez;
             T_bool;
             T_key;
             T_key_hash;
             T_timestamp ]

and parse_packable_ty :
    context -> legacy:bool -> Script.node -> (ex_ty * context) tzresult =
 fun ctxt ~legacy ->
  parse_ty
    ctxt
    ~legacy
    ~allow_big_map:false
    ~allow_operation:false
    ~allow_contract:legacy

and parse_parameter_ty :
    context -> legacy:bool -> Script.node -> (ex_ty * context) tzresult =
 fun ctxt ~legacy ->
  parse_ty
    ctxt
    ~legacy
    ~allow_big_map:true
    ~allow_operation:false
    ~allow_contract:true

and parse_any_ty :
    context -> legacy:bool -> Script.node -> (ex_ty * context) tzresult =
 fun ctxt ~legacy ->
  parse_ty
    ctxt
    ~legacy
    ~allow_big_map:true
    ~allow_operation:true
    ~allow_contract:true

and parse_ty :
    context ->
    legacy:bool ->
    allow_big_map:bool ->
    allow_operation:bool ->
    allow_contract:bool ->
    Script.node ->
    (ex_ty * context) tzresult =
 fun ctxt ~legacy ~allow_big_map ~allow_operation ~allow_contract node ->
  Gas.consume ctxt Typecheck_costs.cycle
  >>? fun ctxt ->
  match node with
  | Prim (loc, T_unit, [], annot) ->
      parse_type_annot loc annot
      >>? fun ty_name ->
      Gas.consume ctxt (Typecheck_costs.type_ 0)
      >|? fun ctxt -> (Ex_ty (Unit_t ty_name), ctxt)
  | Prim (loc, T_int, [], annot) ->
      parse_type_annot loc annot
      >>? fun ty_name ->
      Gas.consume ctxt (Typecheck_costs.type_ 0)
      >|? fun ctxt -> (Ex_ty (Int_t ty_name), ctxt)
  | Prim (loc, T_nat, [], annot) ->
      parse_type_annot loc annot
      >>? fun ty_name ->
      Gas.consume ctxt (Typecheck_costs.type_ 0)
      >|? fun ctxt -> (Ex_ty (Nat_t ty_name), ctxt)
  | Prim (loc, T_string, [], annot) ->
      parse_type_annot loc annot
      >>? fun ty_name ->
      Gas.consume ctxt (Typecheck_costs.type_ 0)
      >|? fun ctxt -> (Ex_ty (String_t ty_name), ctxt)
  | Prim (loc, T_bytes, [], annot) ->
      parse_type_annot loc annot
      >>? fun ty_name ->
      Gas.consume ctxt (Typecheck_costs.type_ 0)
      >|? fun ctxt -> (Ex_ty (Bytes_t ty_name), ctxt)
  | Prim (loc, T_mutez, [], annot) ->
      parse_type_annot loc annot
      >>? fun ty_name ->
      Gas.consume ctxt (Typecheck_costs.type_ 0)
      >|? fun ctxt -> (Ex_ty (Mutez_t ty_name), ctxt)
  | Prim (loc, T_bool, [], annot) ->
      parse_type_annot loc annot
      >>? fun ty_name ->
      Gas.consume ctxt (Typecheck_costs.type_ 0)
      >|? fun ctxt -> (Ex_ty (Bool_t ty_name), ctxt)
  | Prim (loc, T_key, [], annot) ->
      parse_type_annot loc annot
      >>? fun ty_name ->
      Gas.consume ctxt (Typecheck_costs.type_ 0)
      >|? fun ctxt -> (Ex_ty (Key_t ty_name), ctxt)
  | Prim (loc, T_key_hash, [], annot) ->
      parse_type_annot loc annot
      >>? fun ty_name ->
      Gas.consume ctxt (Typecheck_costs.type_ 0)
      >|? fun ctxt -> (Ex_ty (Key_hash_t ty_name), ctxt)
  | Prim (loc, T_timestamp, [], annot) ->
      parse_type_annot loc annot
      >>? fun ty_name ->
      Gas.consume ctxt (Typecheck_costs.type_ 0)
      >|? fun ctxt -> (Ex_ty (Timestamp_t ty_name), ctxt)
  | Prim (loc, T_address, [], annot) ->
      parse_type_annot loc annot
      >>? fun ty_name ->
      Gas.consume ctxt (Typecheck_costs.type_ 0)
      >|? fun ctxt -> (Ex_ty (Address_t ty_name), ctxt)
  | Prim (loc, T_signature, [], annot) ->
      parse_type_annot loc annot
      >>? fun ty_name ->
      Gas.consume ctxt (Typecheck_costs.type_ 0)
      >|? fun ctxt -> (Ex_ty (Signature_t ty_name), ctxt)
  | Prim (loc, T_operation, [], annot) ->
      if allow_operation then
        parse_type_annot loc annot
        >>? fun ty_name ->
        Gas.consume ctxt (Typecheck_costs.type_ 0)
        >|? fun ctxt -> (Ex_ty (Operation_t ty_name), ctxt)
      else error (Unexpected_operation loc)
  | Prim (loc, T_chain_id, [], annot) ->
      parse_type_annot loc annot
      >>? fun ty_name ->
      Gas.consume ctxt (Typecheck_costs.type_ 0)
      >|? fun ctxt -> (Ex_ty (Chain_id_t ty_name), ctxt)
  | Prim (loc, T_contract, [utl], annot) ->
      if allow_contract then
        parse_parameter_ty ctxt ~legacy utl
        >>? fun (Ex_ty tl, ctxt) ->
        parse_type_annot loc annot
        >>? fun ty_name ->
        Gas.consume ctxt (Typecheck_costs.type_ 1)
        >|? fun ctxt -> (Ex_ty (Contract_t (tl, ty_name)), ctxt)
      else error (Unexpected_contract loc)
  | Prim (loc, T_pair, [utl; utr], annot) ->
      extract_field_annot utl
      >>? fun (utl, left_field) ->
      extract_field_annot utr
      >>? fun (utr, right_field) ->
      parse_ty ctxt ~legacy ~allow_big_map ~allow_operation ~allow_contract utl
      >>? fun (Ex_ty tl, ctxt) ->
      parse_ty ctxt ~legacy ~allow_big_map ~allow_operation ~allow_contract utr
      >>? fun (Ex_ty tr, ctxt) ->
      parse_type_annot loc annot
      >>? fun ty_name ->
      Gas.consume ctxt (Typecheck_costs.type_ 2)
      >|? fun ctxt ->
      ( Ex_ty
          (Pair_t
             ( (tl, left_field, None),
               (tr, right_field, None),
               ty_name,
               has_big_map tl || has_big_map tr )),
        ctxt )
  | Prim (loc, T_or, [utl; utr], annot) ->
      extract_field_annot utl
      >>? fun (utl, left_constr) ->
      extract_field_annot utr
      >>? fun (utr, right_constr) ->
      parse_ty ctxt ~legacy ~allow_big_map ~allow_operation ~allow_contract utl
      >>? fun (Ex_ty tl, ctxt) ->
      parse_ty ctxt ~legacy ~allow_big_map ~allow_operation ~allow_contract utr
      >>? fun (Ex_ty tr, ctxt) ->
      parse_type_annot loc annot
      >>? fun ty_name ->
      Gas.consume ctxt (Typecheck_costs.type_ 2)
      >|? fun ctxt ->
      ( Ex_ty
          (Union_t
             ( (tl, left_constr),
               (tr, right_constr),
               ty_name,
               has_big_map tl || has_big_map tr )),
        ctxt )
  | Prim (loc, T_lambda, [uta; utr], annot) ->
      parse_any_ty ctxt ~legacy uta
      >>? fun (Ex_ty ta, ctxt) ->
      parse_any_ty ctxt ~legacy utr
      >>? fun (Ex_ty tr, ctxt) ->
      parse_type_annot loc annot
      >>? fun ty_name ->
      Gas.consume ctxt (Typecheck_costs.type_ 2)
      >|? fun ctxt -> (Ex_ty (Lambda_t (ta, tr, ty_name)), ctxt)
  | Prim (loc, T_option, [ut], annot) ->
      ( if legacy then
        (* legacy semantics with (broken) field annotations *)
        extract_field_annot ut
        >>? fun (ut, _some_constr) ->
        parse_composed_type_annot loc annot
        >>? fun (ty_name, _none_constr, _) -> ok (ut, ty_name)
      else parse_type_annot loc annot >>? fun ty_name -> ok (ut, ty_name) )
      >>? fun (ut, ty_name) ->
      parse_ty ctxt ~legacy ~allow_big_map ~allow_operation ~allow_contract ut
      >>? fun (Ex_ty t, ctxt) ->
      Gas.consume ctxt (Typecheck_costs.type_ 2)
      >|? fun ctxt -> (Ex_ty (Option_t (t, ty_name, has_big_map t)), ctxt)
  | Prim (loc, T_list, [ut], annot) ->
      parse_ty ctxt ~legacy ~allow_big_map ~allow_operation ~allow_contract ut
      >>? fun (Ex_ty t, ctxt) ->
      parse_type_annot loc annot
      >>? fun ty_name ->
      Gas.consume ctxt (Typecheck_costs.type_ 1)
      >|? fun ctxt -> (Ex_ty (List_t (t, ty_name, has_big_map t)), ctxt)
  | Prim (loc, T_set, [ut], annot) ->
      parse_comparable_ty ctxt ut
      >>? fun (Ex_comparable_ty t, ctxt) ->
      parse_type_annot loc annot
      >>? fun ty_name ->
      Gas.consume ctxt (Typecheck_costs.type_ 1)
      >|? fun ctxt -> (Ex_ty (Set_t (t, ty_name)), ctxt)
  | Prim (loc, T_map, [uta; utr], annot) ->
      parse_comparable_ty ctxt uta
      >>? fun (Ex_comparable_ty ta, ctxt) ->
      parse_ty ctxt ~legacy ~allow_big_map ~allow_operation ~allow_contract utr
      >>? fun (Ex_ty tr, ctxt) ->
      parse_type_annot loc annot
      >>? fun ty_name ->
      Gas.consume ctxt (Typecheck_costs.type_ 2)
      >|? fun ctxt -> (Ex_ty (Map_t (ta, tr, ty_name, has_big_map tr)), ctxt)
  | Prim (loc, T_big_map, args, annot) when allow_big_map ->
      parse_big_map_ty ctxt ~legacy loc args annot
      >>? fun (big_map_ty, ctxt) ->
      Gas.consume ctxt (Typecheck_costs.type_ 2)
      >|? fun ctxt -> (big_map_ty, ctxt)
  | Prim (loc, T_big_map, _, _) ->
      error (Unexpected_big_map loc)
  | Prim
      ( loc,
        ( ( T_unit
          | T_signature
          | T_int
          | T_nat
          | T_string
          | T_bytes
          | T_mutez
          | T_bool
          | T_key
          | T_key_hash
          | T_timestamp
          | T_address ) as prim ),
        l,
        _ ) ->
      error (Invalid_arity (loc, prim, 0, List.length l))
  | Prim (loc, ((T_set | T_list | T_option | T_contract) as prim), l, _) ->
      error (Invalid_arity (loc, prim, 1, List.length l))
  | Prim (loc, ((T_pair | T_or | T_map | T_lambda) as prim), l, _) ->
      error (Invalid_arity (loc, prim, 2, List.length l))
  | expr ->
      error
      @@ unexpected
           expr
           []
           Type_namespace
           [ T_pair;
             T_or;
             T_set;
             T_map;
             T_list;
             T_option;
             T_lambda;
             T_unit;
             T_signature;
             T_contract;
             T_int;
             T_nat;
             T_operation;
             T_string;
             T_bytes;
             T_mutez;
             T_bool;
             T_key;
             T_key_hash;
             T_timestamp;
             T_chain_id ]

and parse_big_map_ty ctxt ~legacy big_map_loc args map_annot =
  Gas.consume ctxt Typecheck_costs.cycle
  >>? fun ctxt ->
  match args with
  | [key_ty; value_ty] ->
      parse_comparable_ty ctxt key_ty
      >>? fun (Ex_comparable_ty key_ty, ctxt) ->
      parse_packable_ty ctxt ~legacy value_ty
      >>? fun (Ex_ty value_ty, ctxt) ->
      parse_type_annot big_map_loc map_annot
      >|? fun map_name ->
      let big_map_ty = Big_map_t (key_ty, value_ty, map_name) in
      (Ex_ty big_map_ty, ctxt)
  | args ->
      error @@ Invalid_arity (big_map_loc, T_big_map, 2, List.length args)

and parse_storage_ty :
    context -> legacy:bool -> Script.node -> (ex_ty * context) tzresult =
 fun ctxt ~legacy node ->
  match node with
  | Prim
      ( loc,
        T_pair,
        [Prim (big_map_loc, T_big_map, args, map_annot); remaining_storage],
        storage_annot )
    when legacy -> (
    match storage_annot with
    | [] ->
        parse_ty
          ctxt
          ~legacy
          ~allow_big_map:true
          ~allow_operation:false
          ~allow_contract:legacy
          node
    | [single]
      when Compare.Int.(String.length single > 0)
           && Compare.Char.(single.[0] = '%') ->
        parse_ty
          ctxt
          ~legacy
          ~allow_big_map:true
          ~allow_operation:false
          ~allow_contract:legacy
          node
    | _ ->
        (* legacy semantics of big maps used the wrong annotation parser *)
        Gas.consume ctxt Typecheck_costs.cycle
        >>? fun ctxt ->
        parse_big_map_ty ctxt ~legacy big_map_loc args map_annot
        >>? fun (Ex_ty big_map_ty, ctxt) ->
        parse_ty
          ctxt
          ~legacy
          ~allow_big_map:true
          ~allow_operation:false
          ~allow_contract:legacy
          remaining_storage
        >>? fun (Ex_ty remaining_storage, ctxt) ->
        parse_composed_type_annot loc storage_annot
        >>? fun (ty_name, map_field, storage_field) ->
        Gas.consume ctxt (Typecheck_costs.type_ 5)
        >|? fun ctxt ->
        ( Ex_ty
            (Pair_t
               ( (big_map_ty, map_field, None),
                 (remaining_storage, storage_field, None),
                 ty_name,
                 true )),
          ctxt ) )
  | _ ->
      parse_ty
        ctxt
        ~legacy
        ~allow_big_map:true
        ~allow_operation:false
        ~allow_contract:legacy
        node

let check_packable ~legacy loc root =
  let rec check : type t. t ty -> unit tzresult = function
    | Big_map_t _ ->
        error (Unexpected_big_map loc)
    | Operation_t _ ->
        error (Unexpected_operation loc)
    | Unit_t _ ->
        ok ()
    | Int_t _ ->
        ok ()
    | Nat_t _ ->
        ok ()
    | Signature_t _ ->
        ok ()
    | String_t _ ->
        ok ()
    | Bytes_t _ ->
        ok ()
    | Mutez_t _ ->
        ok ()
    | Key_hash_t _ ->
        ok ()
    | Key_t _ ->
        ok ()
    | Timestamp_t _ ->
        ok ()
    | Address_t _ ->
        ok ()
    | Bool_t _ ->
        ok ()
    | Chain_id_t _ ->
        ok ()
    | Pair_t ((l_ty, _, _), (r_ty, _, _), _, _) ->
        check l_ty >>? fun () -> check r_ty
    | Union_t ((l_ty, _), (r_ty, _), _, _) ->
        check l_ty >>? fun () -> check r_ty
    | Option_t (v_ty, _, _) ->
        check v_ty
    | List_t (elt_ty, _, _) ->
        check elt_ty
    | Set_t (_, _) ->
        ok ()
    | Map_t (_, elt_ty, _, _) ->
        check elt_ty
    | Lambda_t (_l_ty, _r_ty, _) ->
        ok ()
    | Contract_t (_, _) when legacy ->
        ok ()
    | Contract_t (_, _) ->
        error (Unexpected_contract loc)
  in
  check root

type ex_script = Ex_script : ('a, 'c) script -> ex_script

type _ dig_proof_argument =
  | Dig_proof_argument :
      ( ('x * 'rest, 'rest, 'bef, 'aft) stack_prefix_preservation_witness
      * ('x ty * var_annot option)
      * 'aft stack_ty )
      -> 'bef dig_proof_argument

type (_, _) dug_proof_argument =
  | Dug_proof_argument :
      ( ('rest, 'x * 'rest, 'bef, 'aft) stack_prefix_preservation_witness
      * unit
      * 'aft stack_ty )
      -> ('bef, 'x) dug_proof_argument

type _ dipn_proof_argument =
  | Dipn_proof_argument :
      ( ('fbef, 'faft, 'bef, 'aft) stack_prefix_preservation_witness
      * (context * ('fbef, 'faft) descr)
      * 'aft stack_ty )
      -> 'bef dipn_proof_argument

type _ dropn_proof_argument =
  | Dropn_proof_argument :
      ( ('rest, 'rest, 'bef, 'aft) stack_prefix_preservation_witness
      * 'rest stack_ty
      * 'aft stack_ty )
      -> 'bef dropn_proof_argument

(* Lwt versions *)
let parse_var_annot loc ?default annot =
  Lwt.return (parse_var_annot loc ?default annot)

let parse_entrypoint_annot loc ?default annot =
  Lwt.return (parse_entrypoint_annot loc ?default annot)

let parse_constr_annot loc ?if_special_first ?if_special_second annot =
  Lwt.return
    (parse_constr_annot loc ?if_special_first ?if_special_second annot)

let parse_two_var_annot loc annot = Lwt.return (parse_two_var_annot loc annot)

let parse_destr_annot loc annot ~default_accessor ~field_name ~pair_annot
    ~value_annot =
  Lwt.return
    (parse_destr_annot
       loc
       annot
       ~default_accessor
       ~field_name
       ~pair_annot
       ~value_annot)

let parse_var_type_annot loc annot =
  Lwt.return (parse_var_type_annot loc annot)

let find_entrypoint (type full) (full : full ty) ~root_name entrypoint =
  let rec find_entrypoint :
      type t. t ty -> string -> (Script.node -> Script.node) * ex_ty =
   fun t entrypoint ->
    match t with
    | Union_t ((tl, al), (tr, ar), _, _) -> (
        if
          match al with
          | None ->
              false
          | Some (`Field_annot l) ->
              Compare.String.(l = entrypoint)
        then ((fun e -> Prim (0, D_Left, [e], [])), Ex_ty tl)
        else if
          match ar with
          | None ->
              false
          | Some (`Field_annot r) ->
              Compare.String.(r = entrypoint)
        then ((fun e -> Prim (0, D_Right, [e], [])), Ex_ty tr)
        else
          try
            let (f, t) = find_entrypoint tl entrypoint in
            ((fun e -> Prim (0, D_Left, [f e], [])), t)
          with Not_found ->
            let (f, t) = find_entrypoint tr entrypoint in
            ((fun e -> Prim (0, D_Right, [f e], [])), t) )
    | _ ->
        raise Not_found
  in
  let entrypoint =
    if Compare.String.(entrypoint = "") then "default" else entrypoint
  in
  if Compare.Int.(String.length entrypoint > 31) then
    error (Entrypoint_name_too_long entrypoint)
  else
    match root_name with
    | Some root_name when Compare.String.(entrypoint = root_name) ->
        ok ((fun e -> e), Ex_ty full)
    | _ -> (
      try ok (find_entrypoint full entrypoint)
      with Not_found -> (
        match entrypoint with
        | "default" ->
            ok ((fun e -> e), Ex_ty full)
        | _ ->
            error (No_such_entrypoint entrypoint) ) )

let find_entrypoint_for_type (type full exp) ~(full : full ty)
    ~(expected : exp ty) ~root_name entrypoint ctxt :
    (context * string * exp ty) tzresult =
  match (entrypoint, root_name) with
  | ("default", Some "root") -> (
    match find_entrypoint full ~root_name entrypoint with
    | Error _ as err ->
        err
    | Ok (_, Ex_ty ty) -> (
      match ty_eq ctxt expected ty with
      | Ok (Eq, ctxt) ->
          ok (ctxt, "default", (ty : exp ty))
      | Error _ ->
          ty_eq ctxt expected full
          >>? fun (Eq, ctxt) -> ok (ctxt, "root", (full : exp ty)) ) )
  | _ ->
      find_entrypoint full ~root_name entrypoint
      >>? fun (_, Ex_ty ty) ->
      ty_eq ctxt expected ty
      >>? fun (Eq, ctxt) -> ok (ctxt, entrypoint, (ty : exp ty))

module Entrypoints = Set.Make (String)

exception Duplicate of string

exception Too_long of string

let well_formed_entrypoints (type full) (full : full ty) ~root_name =
  let merge path annot (type t) (ty : t ty) reachable
      ((first_unreachable, all) as acc) =
    match annot with
    | None | Some (`Field_annot "") -> (
        if reachable then acc
        else
          match ty with
          | Union_t _ ->
              acc
          | _ -> (
            match first_unreachable with
            | None ->
                (Some (List.rev path), all)
            | Some _ ->
                acc ) )
    | Some (`Field_annot name) ->
        if Compare.Int.(String.length name > 31) then raise (Too_long name)
        else if Entrypoints.mem name all then raise (Duplicate name)
        else (first_unreachable, Entrypoints.add name all)
  in
  let rec check :
      type t.
      t ty ->
      prim list ->
      bool ->
      prim list option * Entrypoints.t ->
      prim list option * Entrypoints.t =
   fun t path reachable acc ->
    match t with
    | Union_t ((tl, al), (tr, ar), _, _) ->
        let acc = merge (D_Left :: path) al tl reachable acc in
        let acc = merge (D_Right :: path) ar tr reachable acc in
        let acc =
          check
            tl
            (D_Left :: path)
            (match al with Some _ -> true | None -> reachable)
            acc
        in
        check
          tr
          (D_Right :: path)
          (match ar with Some _ -> true | None -> reachable)
          acc
    | _ ->
        acc
  in
  try
    let (init, reachable) =
      match root_name with
      | None | Some "" ->
          (Entrypoints.empty, false)
      | Some name ->
          (Entrypoints.singleton name, true)
    in
    let (first_unreachable, all) = check full [] reachable (None, init) in
    if not (Entrypoints.mem "default" all) then ok ()
    else
      match first_unreachable with
      | None ->
          ok ()
      | Some path ->
          error (Unreachable_entrypoint path)
  with
  | Duplicate name ->
      error (Duplicate_entrypoint name)
  | Too_long name ->
      error (Entrypoint_name_too_long name)

let rec parse_data :
    type a.
    ?type_logger:type_logger ->
    context ->
    legacy:bool ->
    a ty ->
    Script.node ->
    (a * context) tzresult Lwt.t =
 fun ?type_logger ctxt ~legacy ty script_data ->
  Lwt.return (Gas.consume ctxt Typecheck_costs.cycle)
  >>=? fun ctxt ->
  let error () =
    Lwt.return (serialize_ty_for_error ctxt ty)
    >>|? fun (ty, _ctxt) ->
    Invalid_constant (location script_data, strip_locations script_data, ty)
  in
  let traced body = trace_eval error body in
  let parse_items ?type_logger loc ctxt expr key_type value_type items
      item_wrapper =
    let length = List.length items in
    fold_left_s
      (fun (last_value, map, ctxt) item ->
        Lwt.return (Gas.consume ctxt (Typecheck_costs.map_element length))
        >>=? fun ctxt ->
        match item with
        | Prim (_, D_Elt, [k; v], _) ->
            parse_comparable_data ?type_logger ctxt key_type k
            >>=? fun (k, ctxt) ->
            parse_data ?type_logger ctxt ~legacy value_type v
            >>=? fun (v, ctxt) ->
            ( match last_value with
            | Some value ->
                if Compare.Int.(0 <= compare_comparable key_type value k) then
                  if Compare.Int.(0 = compare_comparable key_type value k) then
                    fail (Duplicate_map_keys (loc, strip_locations expr))
                  else fail (Unordered_map_keys (loc, strip_locations expr))
                else return_unit
            | None ->
                return_unit )
            >>=? fun () ->
            return (Some k, map_update k (Some (item_wrapper v)) map, ctxt)
        | Prim (loc, D_Elt, l, _) ->
            fail @@ Invalid_arity (loc, D_Elt, 2, List.length l)
        | Prim (loc, name, _, _) ->
            fail @@ Invalid_primitive (loc, [D_Elt], name)
        | Int _ | String _ | Bytes _ | Seq _ ->
            error () >>=? fail)
      (None, empty_map key_type, ctxt)
      items
    |> traced
    >>|? fun (_, items, ctxt) -> (items, ctxt)
  in
  match (ty, script_data) with
  (* Unit *)
  | (Unit_t _, Prim (loc, D_Unit, [], annot)) ->
      (if legacy then return () else fail_unexpected_annot loc annot)
      >>=? fun () ->
      Lwt.return (Gas.consume ctxt Typecheck_costs.unit)
      >>|? fun ctxt -> ((() : a), ctxt)
  | (Unit_t _, Prim (loc, D_Unit, l, _)) ->
      traced (fail (Invalid_arity (loc, D_Unit, 0, List.length l)))
  | (Unit_t _, expr) ->
      traced (fail (unexpected expr [] Constant_namespace [D_Unit]))
  (* Booleans *)
  | (Bool_t _, Prim (loc, D_True, [], annot)) ->
      (if legacy then return () else fail_unexpected_annot loc annot)
      >>=? fun () ->
      Lwt.return (Gas.consume ctxt Typecheck_costs.bool)
      >>|? fun ctxt -> (true, ctxt)
  | (Bool_t _, Prim (loc, D_False, [], annot)) ->
      (if legacy then return () else fail_unexpected_annot loc annot)
      >>=? fun () ->
      Lwt.return (Gas.consume ctxt Typecheck_costs.bool)
      >>|? fun ctxt -> (false, ctxt)
  | (Bool_t _, Prim (loc, ((D_True | D_False) as c), l, _)) ->
      traced (fail (Invalid_arity (loc, c, 0, List.length l)))
  | (Bool_t _, expr) ->
      traced (fail (unexpected expr [] Constant_namespace [D_True; D_False]))
  (* Strings *)
  | (String_t _, String (_, v)) ->
      Lwt.return (Gas.consume ctxt (Typecheck_costs.string (String.length v)))
      >>=? fun ctxt ->
      let rec check_printable_ascii i =
        if Compare.Int.(i < 0) then true
        else
          match v.[i] with
          | '\n' | '\x20' .. '\x7E' ->
              check_printable_ascii (i - 1)
          | _ ->
              false
      in
      if check_printable_ascii (String.length v - 1) then return (v, ctxt)
      else error () >>=? fail
  | (String_t _, expr) ->
      traced (fail (Invalid_kind (location expr, [String_kind], kind expr)))
  (* Byte sequences *)
  | (Bytes_t _, Bytes (_, v)) ->
      Lwt.return (Gas.consume ctxt (Typecheck_costs.string (MBytes.length v)))
      >>=? fun ctxt -> return (v, ctxt)
  | (Bytes_t _, expr) ->
      traced (fail (Invalid_kind (location expr, [Bytes_kind], kind expr)))
  (* Integers *)
  | (Int_t _, Int (_, v)) ->
      Lwt.return (Gas.consume ctxt (Typecheck_costs.z v))
      >>=? fun ctxt -> return (Script_int.of_zint v, ctxt)
  | (Nat_t _, Int (_, v)) ->
      Lwt.return (Gas.consume ctxt (Typecheck_costs.z v))
      >>=? fun ctxt ->
      let v = Script_int.of_zint v in
      if Compare.Int.(Script_int.compare v Script_int.zero >= 0) then
        return (Script_int.abs v, ctxt)
      else error () >>=? fail
  | (Int_t _, expr) ->
      traced (fail (Invalid_kind (location expr, [Int_kind], kind expr)))
  | (Nat_t _, expr) ->
      traced (fail (Invalid_kind (location expr, [Int_kind], kind expr)))
  (* Tez amounts *)
  | (Mutez_t _, Int (_, v)) -> (
      Lwt.return
        ( Gas.consume ctxt Typecheck_costs.tez
        >>? fun ctxt ->
        Gas.consume ctxt Michelson_v1_gas.Cost_of.Legacy.z_to_int64 )
      >>=? fun ctxt ->
      try
        match Tez.of_mutez (Z.to_int64 v) with
        | None ->
            raise Exit
        | Some tez ->
            return (tez, ctxt)
      with _ -> error () >>=? fail )
  | (Mutez_t _, expr) ->
      traced (fail (Invalid_kind (location expr, [Int_kind], kind expr)))
  (* Timestamps *)
  | (Timestamp_t _, Int (_, v))
  (* As unparsed with [Optimized] or out of bounds [Readable]. *) ->
      Lwt.return (Gas.consume ctxt (Typecheck_costs.z v))
      >>=? fun ctxt -> return (Script_timestamp.of_zint v, ctxt)
  | (Timestamp_t _, String (_, s)) (* As unparsed with [Redable]. *) -> (
      Lwt.return (Gas.consume ctxt Typecheck_costs.string_timestamp)
      >>=? fun ctxt ->
      match Script_timestamp.of_string s with
      | Some v ->
          return (v, ctxt)
      | None ->
          error () >>=? fail )
  | (Timestamp_t _, expr) ->
      traced
        (fail
           (Invalid_kind (location expr, [String_kind; Int_kind], kind expr)))
  (* IDs *)
  | (Key_t _, Bytes (_, bytes)) -> (
      (* As unparsed with [Optimized]. *)
      Lwt.return (Gas.consume ctxt Typecheck_costs.key)
      >>=? fun ctxt ->
      match
        Data_encoding.Binary.of_bytes Signature.Public_key.encoding bytes
      with
      | Some k ->
          return (k, ctxt)
      | None ->
          error () >>=? fail )
  | (Key_t _, String (_, s)) -> (
      (* As unparsed with [Readable]. *)
      Lwt.return (Gas.consume ctxt Typecheck_costs.key)
      >>=? fun ctxt ->
      match Signature.Public_key.of_b58check_opt s with
      | Some k ->
          return (k, ctxt)
      | None ->
          error () >>=? fail )
  | (Key_t _, expr) ->
      traced
        (fail
           (Invalid_kind (location expr, [String_kind; Bytes_kind], kind expr)))
  | (Key_hash_t _, Bytes (_, bytes)) -> (
      (* As unparsed with [Optimized]. *)
      Lwt.return (Gas.consume ctxt Typecheck_costs.key_hash)
      >>=? fun ctxt ->
      match
        Data_encoding.Binary.of_bytes Signature.Public_key_hash.encoding bytes
      with
      | Some k ->
          return (k, ctxt)
      | None ->
          error () >>=? fail )
  | (Key_hash_t _, String (_, s)) (* As unparsed with [Readable]. *) -> (
      Lwt.return (Gas.consume ctxt Typecheck_costs.key_hash)
      >>=? fun ctxt ->
      match Signature.Public_key_hash.of_b58check_opt s with
      | Some k ->
          return (k, ctxt)
      | None ->
          error () >>=? fail )
  | (Key_hash_t _, expr) ->
      traced
        (fail
           (Invalid_kind (location expr, [String_kind; Bytes_kind], kind expr)))
  (* Signatures *)
  | (Signature_t _, Bytes (_, bytes)) (* As unparsed with [Optimized]. *) -> (
      Lwt.return (Gas.consume ctxt Typecheck_costs.signature)
      >>=? fun ctxt ->
      match Data_encoding.Binary.of_bytes Signature.encoding bytes with
      | Some k ->
          return (k, ctxt)
      | None ->
          error () >>=? fail )
  | (Signature_t _, String (_, s)) (* As unparsed with [Readable]. *) -> (
      Lwt.return (Gas.consume ctxt Typecheck_costs.signature)
      >>=? fun ctxt ->
      match Signature.of_b58check_opt s with
      | Some s ->
          return (s, ctxt)
      | None ->
          error () >>=? fail )
  | (Signature_t _, expr) ->
      traced
        (fail
           (Invalid_kind (location expr, [String_kind; Bytes_kind], kind expr)))
  (* Operations *)
  | (Operation_t _, _) ->
      (* operations cannot appear in parameters or storage,
           the protocol should never parse the bytes of an operation *)
      assert false
  (* Chain_ids *)
  | (Chain_id_t _, Bytes (_, bytes)) -> (
      Lwt.return (Gas.consume ctxt Typecheck_costs.chain_id)
      >>=? fun ctxt ->
      match Data_encoding.Binary.of_bytes Chain_id.encoding bytes with
      | Some k ->
          return (k, ctxt)
      | None ->
          error () >>=? fail )
  | (Chain_id_t _, String (_, s)) -> (
      Lwt.return (Gas.consume ctxt Typecheck_costs.chain_id)
      >>=? fun ctxt ->
      match Chain_id.of_b58check_opt s with
      | Some s ->
          return (s, ctxt)
      | None ->
          error () >>=? fail )
  | (Chain_id_t _, expr) ->
      traced
        (fail
           (Invalid_kind (location expr, [String_kind; Bytes_kind], kind expr)))
  (* Addresses *)
  | (Address_t _, Bytes (loc, bytes)) (* As unparsed with [O[ptimized]. *) -> (
      Lwt.return (Gas.consume ctxt Typecheck_costs.contract)
      >>=? fun ctxt ->
      match
        Data_encoding.Binary.of_bytes
          Data_encoding.(tup2 Contract.encoding Variable.string)
          bytes
      with
      | Some (c, entrypoint) ->
          if Compare.Int.(String.length entrypoint > 31) then
            fail (Entrypoint_name_too_long entrypoint)
          else
            ( match entrypoint with
            | "" ->
                return "default"
            | "default" ->
                fail (Unexpected_annotation loc)
            | name ->
                return name )
            >>=? fun entrypoint -> return ((c, entrypoint), ctxt)
      | None ->
          error () >>=? fail )
  | (Address_t _, String (loc, s)) (* As unparsed with [Readable]. *) ->
      Lwt.return (Gas.consume ctxt Typecheck_costs.contract)
      >>=? fun ctxt ->
      ( match String.index_opt s '%' with
      | None ->
          return (s, "default")
      | Some pos -> (
          let len = String.length s - pos - 1 in
          let name = String.sub s (pos + 1) len in
          if Compare.Int.(len > 31) then fail (Entrypoint_name_too_long name)
          else
            match (String.sub s 0 pos, name) with
            | (_, "default") ->
                traced (fail (Unexpected_annotation loc))
            | addr_and_name ->
                return addr_and_name ) )
      >>=? fun (addr, entrypoint) ->
      Lwt.return (Contract.of_b58check addr)
      >>=? fun c -> return ((c, entrypoint), ctxt)
  | (Address_t _, expr) ->
      traced
        (fail
           (Invalid_kind (location expr, [String_kind; Bytes_kind], kind expr)))
  (* Contracts *)
  | (Contract_t (ty, _), Bytes (loc, bytes))
  (* As unparsed with [Optimized]. *) -> (
      Lwt.return (Gas.consume ctxt Typecheck_costs.contract)
      >>=? fun ctxt ->
      match
        Data_encoding.Binary.of_bytes
          Data_encoding.(tup2 Contract.encoding Variable.string)
          bytes
      with
      | Some (c, entrypoint) ->
          if Compare.Int.(String.length entrypoint > 31) then
            fail (Entrypoint_name_too_long entrypoint)
          else
            ( match entrypoint with
            | "" ->
                return "default"
            | "default" ->
                traced (fail (Unexpected_annotation loc))
            | name ->
                return name )
            >>=? fun entrypoint ->
            traced (parse_contract ~legacy ctxt loc ty c ~entrypoint)
            >>=? fun (ctxt, _) -> return ((ty, (c, entrypoint)), ctxt)
      | None ->
          error () >>=? fail )
  | (Contract_t (ty, _), String (loc, s)) (* As unparsed with [Readable]. *) ->
      Lwt.return (Gas.consume ctxt Typecheck_costs.contract)
      >>=? fun ctxt ->
      ( match String.index_opt s '%' with
      | None ->
          return (s, "default")
      | Some pos -> (
          let len = String.length s - pos - 1 in
          let name = String.sub s (pos + 1) len in
          if Compare.Int.(len > 31) then fail (Entrypoint_name_too_long name)
          else
            match (String.sub s 0 pos, name) with
            | (_, "default") ->
                traced (fail (Unexpected_annotation loc))
            | addr_and_name ->
                return addr_and_name ) )
      >>=? fun (addr, entrypoint) ->
      traced (Lwt.return (Contract.of_b58check addr))
      >>=? fun c ->
      parse_contract ~legacy ctxt loc ty c ~entrypoint
      >>=? fun (ctxt, _) -> return ((ty, (c, entrypoint)), ctxt)
  | (Contract_t _, expr) ->
      traced
        (fail
           (Invalid_kind (location expr, [String_kind; Bytes_kind], kind expr)))
  (* Pairs *)
  | (Pair_t ((ta, _, _), (tb, _, _), _, _), Prim (loc, D_Pair, [va; vb], annot))
    ->
      (if legacy then return () else fail_unexpected_annot loc annot)
      >>=? fun () ->
      Lwt.return (Gas.consume ctxt Typecheck_costs.pair)
      >>=? fun ctxt ->
      traced @@ parse_data ?type_logger ctxt ~legacy ta va
      >>=? fun (va, ctxt) ->
      parse_data ?type_logger ctxt ~legacy tb vb
      >>=? fun (vb, ctxt) -> return ((va, vb), ctxt)
  | (Pair_t _, Prim (loc, D_Pair, l, _)) ->
      fail @@ Invalid_arity (loc, D_Pair, 2, List.length l)
  | (Pair_t _, expr) ->
      traced (fail (unexpected expr [] Constant_namespace [D_Pair]))
  (* Unions *)
  | (Union_t ((tl, _), _, _, _), Prim (loc, D_Left, [v], annot)) ->
      (if legacy then return () else fail_unexpected_annot loc annot)
      >>=? fun () ->
      Lwt.return (Gas.consume ctxt Typecheck_costs.union)
      >>=? fun ctxt ->
      traced @@ parse_data ?type_logger ctxt ~legacy tl v
      >>=? fun (v, ctxt) -> return (L v, ctxt)
  | (Union_t _, Prim (loc, D_Left, l, _)) ->
      fail @@ Invalid_arity (loc, D_Left, 1, List.length l)
  | (Union_t (_, (tr, _), _, _), Prim (loc, D_Right, [v], annot)) ->
      fail_unexpected_annot loc annot
      >>=? fun () ->
      Lwt.return (Gas.consume ctxt Typecheck_costs.union)
      >>=? fun ctxt ->
      traced @@ parse_data ?type_logger ctxt ~legacy tr v
      >>=? fun (v, ctxt) -> return (R v, ctxt)
  | (Union_t _, Prim (loc, D_Right, l, _)) ->
      fail @@ Invalid_arity (loc, D_Right, 1, List.length l)
  | (Union_t _, expr) ->
      traced (fail (unexpected expr [] Constant_namespace [D_Left; D_Right]))
  (* Lambdas *)
  | (Lambda_t (ta, tr, _ty_name), (Seq (_loc, _) as script_instr)) ->
      Lwt.return (Gas.consume ctxt Typecheck_costs.lambda)
      >>=? fun ctxt ->
      traced
      @@ parse_returning
           Lambda
           ?type_logger
           ctxt
           ~legacy
           (ta, Some (`Var_annot "@arg"))
           tr
           script_instr
  | (Lambda_t _, expr) ->
      traced (fail (Invalid_kind (location expr, [Seq_kind], kind expr)))
  (* Options *)
  | (Option_t (t, _, _), Prim (loc, D_Some, [v], annot)) ->
      (if legacy then return () else fail_unexpected_annot loc annot)
      >>=? fun () ->
      Lwt.return (Gas.consume ctxt Typecheck_costs.some)
      >>=? fun ctxt ->
      traced @@ parse_data ?type_logger ctxt ~legacy t v
      >>=? fun (v, ctxt) -> return (Some v, ctxt)
  | (Option_t _, Prim (loc, D_Some, l, _)) ->
      fail @@ Invalid_arity (loc, D_Some, 1, List.length l)
  | (Option_t (_, _, _), Prim (loc, D_None, [], annot)) ->
      (if legacy then return () else fail_unexpected_annot loc annot)
      >>=? fun () ->
      Lwt.return (Gas.consume ctxt Typecheck_costs.none)
      >>=? fun ctxt -> return (None, ctxt)
  | (Option_t _, Prim (loc, D_None, l, _)) ->
      fail @@ Invalid_arity (loc, D_None, 0, List.length l)
  | (Option_t _, expr) ->
      traced (fail (unexpected expr [] Constant_namespace [D_Some; D_None]))
  (* Lists *)
  | (List_t (t, _ty_name, _), Seq (_loc, items)) ->
      traced
      @@ fold_right_s
           (fun v (rest, ctxt) ->
             Lwt.return (Gas.consume ctxt Typecheck_costs.list_element)
             >>=? fun ctxt ->
             parse_data ?type_logger ctxt ~legacy t v
             >>=? fun (v, ctxt) -> return (v :: rest, ctxt))
           items
           ([], ctxt)
  | (List_t _, expr) ->
      traced (fail (Invalid_kind (location expr, [Seq_kind], kind expr)))
  (* Sets *)
  | (Set_t (t, _ty_name), (Seq (loc, vs) as expr)) ->
      let length = List.length vs in
      traced
      @@ fold_left_s
           (fun (last_value, set, ctxt) v ->
             Lwt.return (Gas.consume ctxt (Typecheck_costs.set_element length))
             >>=? fun ctxt ->
             parse_comparable_data ?type_logger ctxt t v
             >>=? fun (v, ctxt) ->
             ( match last_value with
             | Some value ->
                 if Compare.Int.(0 <= compare_comparable t value v) then
                   if Compare.Int.(0 = compare_comparable t value v) then
                     fail (Duplicate_set_values (loc, strip_locations expr))
                   else fail (Unordered_set_values (loc, strip_locations expr))
                 else return_unit
             | None ->
                 return_unit )
             >>=? fun () ->
             Lwt.return
               (Gas.consume
                  ctxt
                  (Michelson_v1_gas.Cost_of.Legacy.set_update v false set))
             >>=? fun ctxt -> return (Some v, set_update v true set, ctxt))
           (None, empty_set t, ctxt)
           vs
      >>|? fun (_, set, ctxt) -> (set, ctxt)
  | (Set_t _, expr) ->
      traced (fail (Invalid_kind (location expr, [Seq_kind], kind expr)))
  (* Maps *)
  | (Map_t (tk, tv, _ty_name, _), (Seq (loc, vs) as expr)) ->
      parse_items ?type_logger loc ctxt expr tk tv vs (fun x -> x)
  | (Map_t _, expr) ->
      traced (fail (Invalid_kind (location expr, [Seq_kind], kind expr)))
  | (Big_map_t (tk, tv, _ty_name), (Seq (loc, vs) as expr)) ->
      parse_items ?type_logger loc ctxt expr tk tv vs (fun x -> Some x)
      >>|? fun (diff, ctxt) ->
      ( {id = None; diff; key_type = ty_of_comparable_ty tk; value_type = tv},
        ctxt )
  | (Big_map_t (tk, tv, _ty_name), Int (loc, id)) -> (
      Big_map.exists ctxt id
      >>=? function
      | (_, None) ->
          traced (fail (Invalid_big_map (loc, id)))
      | (ctxt, Some (btk, btv)) ->
          Lwt.return
            ( parse_comparable_ty ctxt (Micheline.root btk)
            >>? fun (Ex_comparable_ty btk, ctxt) ->
            parse_packable_ty ctxt ~legacy (Micheline.root btv)
            >>? fun (Ex_ty btv, ctxt) ->
            comparable_ty_eq ctxt tk btk
            >>? fun Eq ->
            ty_eq ctxt tv btv
            >>? fun (Eq, ctxt) ->
            ok
              ( {
                  id = Some id;
                  diff = empty_map tk;
                  key_type = ty_of_comparable_ty tk;
                  value_type = tv;
                },
                ctxt ) ) )
  | (Big_map_t (_tk, _tv, _), expr) ->
      traced
        (fail (Invalid_kind (location expr, [Seq_kind; Int_kind], kind expr)))

and parse_comparable_data :
    type a.
    ?type_logger:type_logger ->
    context ->
    a comparable_ty ->
    Script.node ->
    (a * context) tzresult Lwt.t =
 fun ?type_logger ctxt ty script_data ->
  parse_data
    ?type_logger
    ctxt
    ~legacy:false
    (ty_of_comparable_ty ty)
    script_data

and parse_returning :
    type arg ret.
    ?type_logger:type_logger ->
    tc_context ->
    context ->
    legacy:bool ->
    arg ty * var_annot option ->
    ret ty ->
    Script.node ->
    ((arg, ret) lambda * context) tzresult Lwt.t =
 fun ?type_logger tc_context ctxt ~legacy (arg, arg_annot) ret script_instr ->
  parse_instr
    ?type_logger
    tc_context
    ctxt
    ~legacy
    script_instr
    (Item_t (arg, Empty_t, arg_annot))
  >>=? function
  | (Typed ({loc; aft = Item_t (ty, Empty_t, _) as stack_ty; _} as descr), ctxt)
    ->
      trace_eval
        (fun () ->
          Lwt.return (serialize_ty_for_error ctxt ret)
          >>=? fun (ret, ctxt) ->
          serialize_stack_for_error ctxt stack_ty
          >>|? fun (stack_ty, _ctxt) -> Bad_return (loc, stack_ty, ret))
        ( Lwt.return (ty_eq ctxt ty ret)
        >>=? fun (Eq, ctxt) ->
        Lwt.return (merge_types ~legacy ctxt loc ty ret)
        >>=? fun (_ret, ctxt) ->
        return ((Lam (descr, script_instr) : (arg, ret) lambda), ctxt) )
  | (Typed {loc; aft = stack_ty; _}, ctxt) ->
      Lwt.return (serialize_ty_for_error ctxt ret)
      >>=? fun (ret, ctxt) ->
      serialize_stack_for_error ctxt stack_ty
      >>=? fun (stack_ty, _ctxt) -> fail (Bad_return (loc, stack_ty, ret))
  | (Failed {descr}, ctxt) ->
      return
        ( ( Lam (descr (Item_t (ret, Empty_t, None)), script_instr)
            : (arg, ret) lambda ),
          ctxt )

and parse_int32 (n : (location, prim) Micheline.node) : int tzresult =
  let error' () =
    Invalid_syntactic_constant
      ( location n,
        strip_locations n,
        "a positive 32-bit integer (between 0 and "
        ^ Int32.to_string Int32.max_int
        ^ ")" )
  in
  match n with
  | Micheline.Int (_, n') -> (
    try
      let n'' = Z.to_int n' in
      if
        Compare.Int.(0 <= n'')
        && Compare.Int.(n'' <= Int32.to_int Int32.max_int)
      then ok n''
      else error @@ error' ()
    with _ -> error @@ error' () )
  | _ ->
      error @@ error' ()

and parse_instr :
    type bef.
    ?type_logger:type_logger ->
    tc_context ->
    context ->
    legacy:bool ->
    Script.node ->
    bef stack_ty ->
    (bef judgement * context) tzresult Lwt.t =
 fun ?type_logger tc_context ctxt ~legacy script_instr stack_ty ->
  let _check_item check loc name n m =
    trace_eval (fun () ->
        serialize_stack_for_error ctxt stack_ty
        >>|? fun (stack_ty, _ctxt) -> Bad_stack (loc, name, m, stack_ty))
    @@ trace (Bad_stack_item n) @@ Lwt.return check
  in
  let check_item_ty (type a b) ctxt (exp : a ty) (got : b ty) loc name n m :
      ((a, b) eq * a ty * context) tzresult Lwt.t =
    trace_eval (fun () ->
        serialize_stack_for_error ctxt stack_ty
        >>|? fun (stack_ty, _ctxt) -> Bad_stack (loc, name, m, stack_ty))
    @@ trace (Bad_stack_item n)
    @@ Lwt.return
         ( ty_eq ctxt exp got
         >>? fun (Eq, ctxt) ->
         merge_types ~legacy ctxt loc exp got
         >>? fun (ty, ctxt) -> ok ((Eq : (a, b) eq), (ty : a ty), ctxt) )
  in
  let check_item_comparable_ty (type a b) (exp : a comparable_ty)
      (got : b comparable_ty) loc name n m :
      ((a, b) eq * a comparable_ty) tzresult Lwt.t =
    trace_eval (fun () ->
        serialize_stack_for_error ctxt stack_ty
        >>|? fun (stack_ty, _ctxt) -> Bad_stack (loc, name, m, stack_ty))
    @@ trace (Bad_stack_item n)
    @@ Lwt.return
         ( comparable_ty_eq ctxt exp got
         >>? fun Eq ->
         merge_comparable_types ~legacy exp got
         >>? fun ty -> ok ((Eq : (a, b) eq), (ty : a comparable_ty)) )
  in
  let log_stack ctxt loc stack_ty aft =
    match (type_logger, script_instr) with
    | (None, _) | (Some _, (Seq (-1, _) | Int _ | String _ | Bytes _)) ->
        return_unit
    | (Some log, (Prim _ | Seq _)) ->
        (* Unparsing for logging done in an unlimited context as this
             is used only by the client and not the protocol *)
        let ctxt = Gas.set_unlimited ctxt in
        unparse_stack ctxt stack_ty
        >>=? fun (stack_ty, _) ->
        unparse_stack ctxt aft
        >>=? fun (aft, _) -> log loc stack_ty aft ; return_unit
  in
  let outer_return = return in
  let return :
      type bef.
      context -> bef judgement -> (bef judgement * context) tzresult Lwt.t =
   fun ctxt judgement ->
    match judgement with
    | Typed {instr; loc; aft; _} ->
        let maximum_type_size = Constants.michelson_maximum_type_size ctxt in
        let type_size =
          type_size_of_stack_head
            aft
            ~up_to:(number_of_generated_growing_types instr)
        in
        if Compare.Int.(type_size > maximum_type_size) then
          fail (Type_too_large (loc, type_size, maximum_type_size))
        else return (judgement, ctxt)
    | Failed _ ->
        return (judgement, ctxt)
  in
  let typed ctxt loc instr aft =
    log_stack ctxt loc stack_ty aft
    >>=? fun () ->
    Lwt.return @@ Gas.consume ctxt (Typecheck_costs.instr instr)
    >>=? fun ctxt -> return ctxt (Typed {loc; instr; bef = stack_ty; aft})
  in
  Lwt.return @@ Gas.consume ctxt Typecheck_costs.cycle
  >>=? fun ctxt ->
  match (script_instr, stack_ty) with
  (* stack ops *)
  | (Prim (loc, I_DROP, [], annot), Item_t (_, rest, _)) ->
      ( fail_unexpected_annot loc annot >>=? fun () -> typed ctxt loc Drop rest
        : (bef judgement * context) tzresult Lwt.t )
  | (Prim (loc, I_DROP, [n], result_annot), whole_stack) ->
      Lwt.return (parse_int32 n)
      >>=? fun whole_n ->
      let rec make_proof_argument :
          type tstk.
          int -> tstk stack_ty -> tstk dropn_proof_argument tzresult Lwt.t =
       fun n stk ->
        match (Compare.Int.(n = 0), stk) with
        | (true, rest) ->
            outer_return @@ Dropn_proof_argument (Rest, rest, rest)
        | (false, Item_t (v, rest, annot)) ->
            make_proof_argument (n - 1) rest
            >>=? fun (Dropn_proof_argument (n', stack_after_drops, aft')) ->
            outer_return
            @@ Dropn_proof_argument
                 (Prefix n', stack_after_drops, Item_t (v, aft', annot))
        | (_, _) ->
            serialize_stack_for_error ctxt whole_stack
            >>=? fun (whole_stack, _ctxt) ->
            fail (Bad_stack (loc, I_DROP, whole_n, whole_stack))
      in
      fail_unexpected_annot loc result_annot
      >>=? fun () ->
      make_proof_argument whole_n whole_stack
      >>=? fun (Dropn_proof_argument (n', stack_after_drops, _aft)) ->
      typed ctxt loc (Dropn (whole_n, n')) stack_after_drops
  | (Prim (loc, I_DROP, (_ :: _ :: _ as l), _), _) ->
      (* Technically, the arities 0 and 1 are allowed but the error only mentions 1.
           However, DROP is equivalent to DROP 1 so hinting at an arity of 1 makes sense. *)
      fail (Invalid_arity (loc, I_DROP, 1, List.length l))
  | (Prim (loc, I_DUP, [], annot), Item_t (v, rest, stack_annot)) ->
      parse_var_annot loc annot ~default:stack_annot
      >>=? fun annot ->
      typed ctxt loc Dup (Item_t (v, Item_t (v, rest, stack_annot), annot))
  | (Prim (loc, I_DIG, [n], result_annot), stack) ->
      let rec make_proof_argument :
          type tstk.
          int -> tstk stack_ty -> tstk dig_proof_argument tzresult Lwt.t =
       fun n stk ->
        match (Compare.Int.(n = 0), stk) with
        | (true, Item_t (v, rest, annot)) ->
            outer_return @@ Dig_proof_argument (Rest, (v, annot), rest)
        | (false, Item_t (v, rest, annot)) ->
            make_proof_argument (n - 1) rest
            >>=? fun (Dig_proof_argument (n', (x, xv), aft')) ->
            outer_return
            @@ Dig_proof_argument (Prefix n', (x, xv), Item_t (v, aft', annot))
        | (_, _) ->
            serialize_stack_for_error ctxt stack
            >>=? fun (whole_stack, _ctxt) ->
            fail (Bad_stack (loc, I_DIG, 1, whole_stack))
      in
      Lwt.return (parse_int32 n)
      >>=? fun n ->
      fail_unexpected_annot loc result_annot
      >>=? fun () ->
      make_proof_argument n stack
      >>=? fun (Dig_proof_argument (n', (x, stack_annot), aft)) ->
      typed ctxt loc (Dig (n, n')) (Item_t (x, aft, stack_annot))
  | (Prim (loc, I_DIG, (([] | _ :: _ :: _) as l), _), _) ->
      fail (Invalid_arity (loc, I_DIG, 1, List.length l))
  | (Prim (loc, I_DUG, [n], result_annot), Item_t (x, whole_stack, stack_annot))
    ->
      Lwt.return (parse_int32 n)
      >>=? fun whole_n ->
      let rec make_proof_argument :
          type tstk x.
          int ->
          x ty ->
          var_annot option ->
          tstk stack_ty ->
          (tstk, x) dug_proof_argument tzresult Lwt.t =
       fun n x stack_annot stk ->
        match (Compare.Int.(n = 0), stk) with
        | (true, rest) ->
            outer_return
            @@ Dug_proof_argument (Rest, (), Item_t (x, rest, stack_annot))
        | (false, Item_t (v, rest, annot)) ->
            make_proof_argument (n - 1) x stack_annot rest
            >>=? fun (Dug_proof_argument (n', (), aft')) ->
            outer_return
            @@ Dug_proof_argument (Prefix n', (), Item_t (v, aft', annot))
        | (_, _) ->
            serialize_stack_for_error ctxt whole_stack
            >>=? fun (whole_stack, _ctxt) ->
            fail (Bad_stack (loc, I_DUG, whole_n, whole_stack))
      in
      fail_unexpected_annot loc result_annot
      >>=? fun () ->
      make_proof_argument whole_n x stack_annot whole_stack
      >>=? fun (Dug_proof_argument (n', (), aft)) ->
      typed ctxt loc (Dug (whole_n, n')) aft
  | (Prim (loc, I_DUG, [_], result_annot), (Empty_t as stack)) ->
      fail_unexpected_annot loc result_annot
      >>=? fun () ->
      serialize_stack_for_error ctxt stack
      >>=? fun (stack, _ctxt) -> fail (Bad_stack (loc, I_DUG, 1, stack))
  | (Prim (loc, I_DUG, (([] | _ :: _ :: _) as l), _), _) ->
      fail (Invalid_arity (loc, I_DUG, 1, List.length l))
  | ( Prim (loc, I_SWAP, [], annot),
      Item_t (v, Item_t (w, rest, stack_annot), cur_top_annot) ) ->
      fail_unexpected_annot loc annot
      >>=? fun () ->
      typed
        ctxt
        loc
        Swap
        (Item_t (w, Item_t (v, rest, cur_top_annot), stack_annot))
  | (Prim (loc, I_PUSH, [t; d], annot), stack) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      Lwt.return @@ parse_packable_ty ctxt ~legacy t
      >>=? fun (Ex_ty t, ctxt) ->
      parse_data ?type_logger ctxt ~legacy t d
      >>=? fun (v, ctxt) -> typed ctxt loc (Const v) (Item_t (t, stack, annot))
  | (Prim (loc, I_UNIT, [], annot), stack) ->
      parse_var_type_annot loc annot
      >>=? fun (annot, ty_name) ->
      typed ctxt loc (Const ()) (Item_t (Unit_t ty_name, stack, annot))
  (* options *)
  | (Prim (loc, I_SOME, [], annot), Item_t (t, rest, _)) ->
      parse_var_type_annot loc annot
      >>=? fun (annot, ty_name) ->
      typed
        ctxt
        loc
        Cons_some
        (Item_t (Option_t (t, ty_name, has_big_map t), rest, annot))
  | (Prim (loc, I_NONE, [t], annot), stack) ->
      Lwt.return @@ parse_any_ty ctxt ~legacy t
      >>=? fun (Ex_ty t, ctxt) ->
      parse_var_type_annot loc annot
      >>=? fun (annot, ty_name) ->
      typed
        ctxt
        loc
        (Cons_none t)
        (Item_t (Option_t (t, ty_name, has_big_map t), stack, annot))
  | ( Prim (loc, I_IF_NONE, [bt; bf], annot),
      (Item_t (Option_t (t, _, _), rest, option_annot) as bef) ) ->
      check_kind [Seq_kind] bt
      >>=? fun () ->
      check_kind [Seq_kind] bf
      >>=? fun () ->
      fail_unexpected_annot loc annot
      >>=? fun () ->
      let annot = gen_access_annot option_annot default_some_annot in
      parse_instr ?type_logger tc_context ctxt ~legacy bt rest
      >>=? fun (btr, ctxt) ->
      parse_instr
        ?type_logger
        tc_context
        ctxt
        ~legacy
        bf
        (Item_t (t, rest, annot))
      >>=? fun (bfr, ctxt) ->
      let branch ibt ibf =
        {loc; instr = If_none (ibt, ibf); bef; aft = ibt.aft}
      in
      merge_branches ~legacy ctxt loc btr bfr {branch}
      >>=? fun (judgement, ctxt) -> return ctxt judgement
  (* pairs *)
  | ( Prim (loc, I_PAIR, [], annot),
      Item_t (a, Item_t (b, rest, snd_annot), fst_annot) ) ->
      parse_constr_annot
        loc
        annot
        ~if_special_first:(var_to_field_annot fst_annot)
        ~if_special_second:(var_to_field_annot snd_annot)
      >>=? fun (annot, ty_name, l_field, r_field) ->
      typed
        ctxt
        loc
        Cons_pair
        (Item_t
           ( Pair_t
               ( (a, l_field, fst_annot),
                 (b, r_field, snd_annot),
                 ty_name,
                 has_big_map a || has_big_map b ),
             rest,
             annot ))
  | ( Prim (loc, I_CAR, [], annot),
      Item_t
        (Pair_t ((a, expected_field_annot, a_annot), _, _, _), rest, pair_annot)
    ) ->
      parse_destr_annot
        loc
        annot
        ~pair_annot
        ~value_annot:a_annot
        ~field_name:expected_field_annot
        ~default_accessor:default_car_annot
      >>=? fun (annot, field_annot) ->
      Lwt.return @@ check_correct_field field_annot expected_field_annot
      >>=? fun () -> typed ctxt loc Car (Item_t (a, rest, annot))
  | ( Prim (loc, I_CDR, [], annot),
      Item_t
        (Pair_t (_, (b, expected_field_annot, b_annot), _, _), rest, pair_annot)
    ) ->
      parse_destr_annot
        loc
        annot
        ~pair_annot
        ~value_annot:b_annot
        ~field_name:expected_field_annot
        ~default_accessor:default_cdr_annot
      >>=? fun (annot, field_annot) ->
      Lwt.return @@ check_correct_field field_annot expected_field_annot
      >>=? fun () -> typed ctxt loc Cdr (Item_t (b, rest, annot))
  (* unions *)
  | (Prim (loc, I_LEFT, [tr], annot), Item_t (tl, rest, stack_annot)) ->
      Lwt.return @@ parse_any_ty ctxt ~legacy tr
      >>=? fun (Ex_ty tr, ctxt) ->
      parse_constr_annot
        loc
        annot
        ~if_special_first:(var_to_field_annot stack_annot)
      >>=? fun (annot, tname, l_field, r_field) ->
      typed
        ctxt
        loc
        Left
        (Item_t
           ( Union_t
               ( (tl, l_field),
                 (tr, r_field),
                 tname,
                 has_big_map tl || has_big_map tr ),
             rest,
             annot ))
  | (Prim (loc, I_RIGHT, [tl], annot), Item_t (tr, rest, stack_annot)) ->
      Lwt.return @@ parse_any_ty ctxt ~legacy tl
      >>=? fun (Ex_ty tl, ctxt) ->
      parse_constr_annot
        loc
        annot
        ~if_special_second:(var_to_field_annot stack_annot)
      >>=? fun (annot, tname, l_field, r_field) ->
      typed
        ctxt
        loc
        Right
        (Item_t
           ( Union_t
               ( (tl, l_field),
                 (tr, r_field),
                 tname,
                 has_big_map tl || has_big_map tr ),
             rest,
             annot ))
  | ( Prim (loc, I_IF_LEFT, [bt; bf], annot),
      ( Item_t (Union_t ((tl, l_field), (tr, r_field), _, _), rest, union_annot)
      as bef ) ) ->
      check_kind [Seq_kind] bt
      >>=? fun () ->
      check_kind [Seq_kind] bf
      >>=? fun () ->
      fail_unexpected_annot loc annot
      >>=? fun () ->
      let left_annot =
        gen_access_annot union_annot l_field ~default:default_left_annot
      in
      let right_annot =
        gen_access_annot union_annot r_field ~default:default_right_annot
      in
      parse_instr
        ?type_logger
        tc_context
        ctxt
        ~legacy
        bt
        (Item_t (tl, rest, left_annot))
      >>=? fun (btr, ctxt) ->
      parse_instr
        ?type_logger
        tc_context
        ctxt
        ~legacy
        bf
        (Item_t (tr, rest, right_annot))
      >>=? fun (bfr, ctxt) ->
      let branch ibt ibf =
        {loc; instr = If_left (ibt, ibf); bef; aft = ibt.aft}
      in
      merge_branches ~legacy ctxt loc btr bfr {branch}
      >>=? fun (judgement, ctxt) -> return ctxt judgement
  (* lists *)
  | (Prim (loc, I_NIL, [t], annot), stack) ->
      Lwt.return @@ parse_any_ty ctxt ~legacy t
      >>=? fun (Ex_ty t, ctxt) ->
      parse_var_type_annot loc annot
      >>=? fun (annot, ty_name) ->
      typed
        ctxt
        loc
        Nil
        (Item_t (List_t (t, ty_name, has_big_map t), stack, annot))
  | ( Prim (loc, I_CONS, [], annot),
      Item_t (tv, Item_t (List_t (t, ty_name, has_big_map), rest, _), _) ) ->
      check_item_ty ctxt tv t loc I_CONS 1 2
      >>=? fun (Eq, t, ctxt) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      typed
        ctxt
        loc
        Cons_list
        (Item_t (List_t (t, ty_name, has_big_map), rest, annot))
  | ( Prim (loc, I_IF_CONS, [bt; bf], annot),
      (Item_t (List_t (t, ty_name, has_big_map), rest, list_annot) as bef) ) ->
      check_kind [Seq_kind] bt
      >>=? fun () ->
      check_kind [Seq_kind] bf
      >>=? fun () ->
      fail_unexpected_annot loc annot
      >>=? fun () ->
      let hd_annot = gen_access_annot list_annot default_hd_annot in
      let tl_annot = gen_access_annot list_annot default_tl_annot in
      parse_instr
        ?type_logger
        tc_context
        ctxt
        ~legacy
        bt
        (Item_t
           ( t,
             Item_t (List_t (t, ty_name, has_big_map), rest, tl_annot),
             hd_annot ))
      >>=? fun (btr, ctxt) ->
      parse_instr ?type_logger tc_context ctxt ~legacy bf rest
      >>=? fun (bfr, ctxt) ->
      let branch ibt ibf =
        {loc; instr = If_cons (ibt, ibf); bef; aft = ibt.aft}
      in
      merge_branches ~legacy ctxt loc btr bfr {branch}
      >>=? fun (judgement, ctxt) -> return ctxt judgement
  | (Prim (loc, I_SIZE, [], annot), Item_t (List_t _, rest, _)) ->
      parse_var_type_annot loc annot
      >>=? fun (annot, tname) ->
      typed ctxt loc List_size (Item_t (Nat_t tname, rest, annot))
  | ( Prim (loc, I_MAP, [body], annot),
      Item_t (List_t (elt, _, _), starting_rest, list_annot) ) -> (
      check_kind [Seq_kind] body
      >>=? fun () ->
      parse_var_type_annot loc annot
      >>=? fun (ret_annot, list_ty_name) ->
      let elt_annot = gen_access_annot list_annot default_elt_annot in
      parse_instr
        ?type_logger
        tc_context
        ctxt
        ~legacy
        body
        (Item_t (elt, starting_rest, elt_annot))
      >>=? fun (judgement, ctxt) ->
      match judgement with
      | Typed ({aft = Item_t (ret, rest, _); _} as ibody) ->
          let invalid_map_body () =
            serialize_stack_for_error ctxt ibody.aft
            >>|? fun (aft, _ctxt) -> Invalid_map_body (loc, aft)
          in
          trace_eval
            invalid_map_body
            ( Lwt.return @@ stack_ty_eq ctxt 1 rest starting_rest
            >>=? fun (Eq, ctxt) ->
            Lwt.return @@ merge_stacks ~legacy loc ctxt rest starting_rest
            >>=? fun (rest, ctxt) ->
            typed
              ctxt
              loc
              (List_map ibody)
              (Item_t
                 (List_t (ret, list_ty_name, has_big_map ret), rest, ret_annot))
            )
      | Typed {aft; _} ->
          serialize_stack_for_error ctxt aft
          >>=? fun (aft, _ctxt) -> fail (Invalid_map_body (loc, aft))
      | Failed _ ->
          fail (Invalid_map_block_fail loc) )
  | ( Prim (loc, I_ITER, [body], annot),
      Item_t (List_t (elt, _, _), rest, list_annot) ) -> (
      check_kind [Seq_kind] body
      >>=? fun () ->
      fail_unexpected_annot loc annot
      >>=? fun () ->
      let elt_annot = gen_access_annot list_annot default_elt_annot in
      parse_instr
        ?type_logger
        tc_context
        ctxt
        ~legacy
        body
        (Item_t (elt, rest, elt_annot))
      >>=? fun (judgement, ctxt) ->
      match judgement with
      | Typed ({aft; _} as ibody) ->
          let invalid_iter_body () =
            serialize_stack_for_error ctxt ibody.aft
            >>=? fun (aft, ctxt) ->
            serialize_stack_for_error ctxt rest
            >>|? fun (rest, _ctxt) -> Invalid_iter_body (loc, rest, aft)
          in
          trace_eval
            invalid_iter_body
            ( Lwt.return @@ stack_ty_eq ctxt 1 aft rest
            >>=? fun (Eq, ctxt) ->
            Lwt.return @@ merge_stacks ~legacy loc ctxt aft rest
            >>=? fun (rest, ctxt) -> typed ctxt loc (List_iter ibody) rest )
      | Failed {descr} ->
          typed ctxt loc (List_iter (descr rest)) rest )
  (* sets *)
  | (Prim (loc, I_EMPTY_SET, [t], annot), rest) ->
      Lwt.return @@ parse_comparable_ty ctxt t
      >>=? fun (Ex_comparable_ty t, ctxt) ->
      parse_var_type_annot loc annot
      >>=? fun (annot, tname) ->
      typed ctxt loc (Empty_set t) (Item_t (Set_t (t, tname), rest, annot))
  | ( Prim (loc, I_ITER, [body], annot),
      Item_t (Set_t (comp_elt, _), rest, set_annot) ) -> (
      check_kind [Seq_kind] body
      >>=? fun () ->
      fail_unexpected_annot loc annot
      >>=? fun () ->
      let elt_annot = gen_access_annot set_annot default_elt_annot in
      let elt = ty_of_comparable_ty comp_elt in
      parse_instr
        ?type_logger
        tc_context
        ctxt
        ~legacy
        body
        (Item_t (elt, rest, elt_annot))
      >>=? fun (judgement, ctxt) ->
      match judgement with
      | Typed ({aft; _} as ibody) ->
          let invalid_iter_body () =
            serialize_stack_for_error ctxt ibody.aft
            >>=? fun (aft, ctxt) ->
            serialize_stack_for_error ctxt rest
            >>|? fun (rest, _ctxt) -> Invalid_iter_body (loc, rest, aft)
          in
          trace_eval
            invalid_iter_body
            ( Lwt.return @@ stack_ty_eq ctxt 1 aft rest
            >>=? fun (Eq, ctxt) ->
            Lwt.return @@ merge_stacks ~legacy loc ctxt aft rest
            >>=? fun (rest, ctxt) -> typed ctxt loc (Set_iter ibody) rest )
      | Failed {descr} ->
          typed ctxt loc (Set_iter (descr rest)) rest )
  | ( Prim (loc, I_MEM, [], annot),
      Item_t (v, Item_t (Set_t (elt, _), rest, _), _) ) ->
      let elt = ty_of_comparable_ty elt in
      parse_var_type_annot loc annot
      >>=? fun (annot, tname) ->
      check_item_ty ctxt elt v loc I_MEM 1 2
      >>=? fun (Eq, _, ctxt) ->
      typed ctxt loc Set_mem (Item_t (Bool_t tname, rest, annot))
  | ( Prim (loc, I_UPDATE, [], annot),
      Item_t
        ( v,
          Item_t (Bool_t _, Item_t (Set_t (elt, tname), rest, set_annot), _),
          _ ) ) -> (
    match comparable_ty_of_ty v with
    | None ->
        unparse_ty ctxt v
        >>=? fun (v, _ctxt) ->
        fail (Comparable_type_expected (loc, Micheline.strip_locations v))
    | Some v ->
        parse_var_annot loc annot ~default:set_annot
        >>=? fun annot ->
        check_item_comparable_ty elt v loc I_UPDATE 1 3
        >>=? fun (Eq, elt) ->
        typed ctxt loc Set_update (Item_t (Set_t (elt, tname), rest, annot)) )
  | (Prim (loc, I_SIZE, [], annot), Item_t (Set_t _, rest, _)) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      typed ctxt loc Set_size (Item_t (Nat_t None, rest, annot))
  (* maps *)
  | (Prim (loc, I_EMPTY_MAP, [tk; tv], annot), stack) ->
      Lwt.return @@ parse_comparable_ty ctxt tk
      >>=? fun (Ex_comparable_ty tk, ctxt) ->
      Lwt.return @@ parse_any_ty ctxt ~legacy tv
      >>=? fun (Ex_ty tv, ctxt) ->
      parse_var_type_annot loc annot
      >>=? fun (annot, ty_name) ->
      typed
        ctxt
        loc
        (Empty_map (tk, tv))
        (Item_t (Map_t (tk, tv, ty_name, has_big_map tv), stack, annot))
  | ( Prim (loc, I_MAP, [body], annot),
      Item_t (Map_t (ck, elt, _, _), starting_rest, _map_annot) ) -> (
      let k = ty_of_comparable_ty ck in
      check_kind [Seq_kind] body
      >>=? fun () ->
      parse_var_type_annot loc annot
      >>=? fun (ret_annot, ty_name) ->
      let k_name = field_to_var_annot default_key_annot in
      let e_name = field_to_var_annot default_elt_annot in
      parse_instr
        ?type_logger
        tc_context
        ctxt
        ~legacy
        body
        (Item_t
           ( Pair_t
               ((k, None, k_name), (elt, None, e_name), None, has_big_map elt),
             starting_rest,
             None ))
      >>=? fun (judgement, ctxt) ->
      match judgement with
      | Typed ({aft = Item_t (ret, rest, _); _} as ibody) ->
          let invalid_map_body () =
            serialize_stack_for_error ctxt ibody.aft
            >>|? fun (aft, _ctxt) -> Invalid_map_body (loc, aft)
          in
          trace_eval
            invalid_map_body
            ( Lwt.return @@ stack_ty_eq ctxt 1 rest starting_rest
            >>=? fun (Eq, ctxt) ->
            Lwt.return @@ merge_stacks ~legacy loc ctxt rest starting_rest
            >>=? fun (rest, ctxt) ->
            typed
              ctxt
              loc
              (Map_map ibody)
              (Item_t
                 (Map_t (ck, ret, ty_name, has_big_map ret), rest, ret_annot))
            )
      | Typed {aft; _} ->
          serialize_stack_for_error ctxt aft
          >>=? fun (aft, _ctxt) -> fail (Invalid_map_body (loc, aft))
      | Failed _ ->
          fail (Invalid_map_block_fail loc) )
  | ( Prim (loc, I_ITER, [body], annot),
      Item_t (Map_t (comp_elt, element_ty, _, _), rest, _map_annot) ) -> (
      check_kind [Seq_kind] body
      >>=? fun () ->
      fail_unexpected_annot loc annot
      >>=? fun () ->
      let k_name = field_to_var_annot default_key_annot in
      let e_name = field_to_var_annot default_elt_annot in
      let key = ty_of_comparable_ty comp_elt in
      parse_instr
        ?type_logger
        tc_context
        ctxt
        ~legacy
        body
        (Item_t
           ( Pair_t
               ( (key, None, k_name),
                 (element_ty, None, e_name),
                 None,
                 has_big_map element_ty ),
             rest,
             None ))
      >>=? fun (judgement, ctxt) ->
      match judgement with
      | Typed ({aft; _} as ibody) ->
          let invalid_iter_body () =
            serialize_stack_for_error ctxt ibody.aft
            >>=? fun (aft, ctxt) ->
            serialize_stack_for_error ctxt rest
            >>|? fun (rest, _ctxt) -> Invalid_iter_body (loc, rest, aft)
          in
          trace_eval
            invalid_iter_body
            ( Lwt.return @@ stack_ty_eq ctxt 1 aft rest
            >>=? fun (Eq, ctxt) ->
            Lwt.return @@ merge_stacks ~legacy loc ctxt aft rest
            >>=? fun (rest, ctxt) -> typed ctxt loc (Map_iter ibody) rest )
      | Failed {descr} ->
          typed ctxt loc (Map_iter (descr rest)) rest )
  | ( Prim (loc, I_MEM, [], annot),
      Item_t (vk, Item_t (Map_t (ck, _, _, _), rest, _), _) ) ->
      let k = ty_of_comparable_ty ck in
      check_item_ty ctxt vk k loc I_MEM 1 2
      >>=? fun (Eq, _, ctxt) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      typed ctxt loc Map_mem (Item_t (Bool_t None, rest, annot))
  | ( Prim (loc, I_GET, [], annot),
      Item_t (vk, Item_t (Map_t (ck, elt, _, has_big_map), rest, _), _) ) ->
      let k = ty_of_comparable_ty ck in
      check_item_ty ctxt vk k loc I_GET 1 2
      >>=? fun (Eq, _, ctxt) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      typed
        ctxt
        loc
        Map_get
        (Item_t (Option_t (elt, None, has_big_map), rest, annot))
  | ( Prim (loc, I_UPDATE, [], annot),
      Item_t
        ( vk,
          Item_t
            ( Option_t (vv, _, _),
              Item_t (Map_t (ck, v, map_name, has_big_map), rest, map_annot),
              _ ),
          _ ) ) ->
      let k = ty_of_comparable_ty ck in
      check_item_ty ctxt vk k loc I_UPDATE 1 3
      >>=? fun (Eq, _, ctxt) ->
      check_item_ty ctxt vv v loc I_UPDATE 2 3
      >>=? fun (Eq, v, ctxt) ->
      parse_var_annot loc annot ~default:map_annot
      >>=? fun annot ->
      typed
        ctxt
        loc
        Map_update
        (Item_t (Map_t (ck, v, map_name, has_big_map), rest, annot))
  | (Prim (loc, I_SIZE, [], annot), Item_t (Map_t (_, _, _, _), rest, _)) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      typed ctxt loc Map_size (Item_t (Nat_t None, rest, annot))
  (* big_map *)
  | (Prim (loc, I_EMPTY_BIG_MAP, [tk; tv], annot), stack) ->
      Lwt.return @@ parse_comparable_ty ctxt tk
      >>=? fun (Ex_comparable_ty tk, ctxt) ->
      Lwt.return @@ parse_packable_ty ctxt ~legacy tv
      >>=? fun (Ex_ty tv, ctxt) ->
      parse_var_type_annot loc annot
      >>=? fun (annot, ty_name) ->
      typed
        ctxt
        loc
        (Empty_big_map (tk, tv))
        (Item_t (Big_map_t (tk, tv, ty_name), stack, annot))
  | ( Prim (loc, I_MEM, [], annot),
      Item_t (set_key, Item_t (Big_map_t (map_key, _, _), rest, _), _) ) ->
      let k = ty_of_comparable_ty map_key in
      check_item_ty ctxt set_key k loc I_MEM 1 2
      >>=? fun (Eq, _, ctxt) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      typed ctxt loc Big_map_mem (Item_t (Bool_t None, rest, annot))
  | ( Prim (loc, I_GET, [], annot),
      Item_t (vk, Item_t (Big_map_t (ck, elt, _), rest, _), _) ) ->
      let k = ty_of_comparable_ty ck in
      check_item_ty ctxt vk k loc I_GET 1 2
      >>=? fun (Eq, _, ctxt) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      typed
        ctxt
        loc
        Big_map_get
        (Item_t (Option_t (elt, None, has_big_map elt), rest, annot))
  | ( Prim (loc, I_UPDATE, [], annot),
      Item_t
        ( set_key,
          Item_t
            ( Option_t (set_value, _, _),
              Item_t (Big_map_t (map_key, map_value, map_name), rest, map_annot),
              _ ),
          _ ) ) ->
      let k = ty_of_comparable_ty map_key in
      check_item_ty ctxt set_key k loc I_UPDATE 1 3
      >>=? fun (Eq, _, ctxt) ->
      check_item_ty ctxt set_value map_value loc I_UPDATE 2 3
      >>=? fun (Eq, map_value, ctxt) ->
      parse_var_annot loc annot ~default:map_annot
      >>=? fun annot ->
      typed
        ctxt
        loc
        Big_map_update
        (Item_t (Big_map_t (map_key, map_value, map_name), rest, annot))
  (* control *)
  | (Seq (loc, []), stack) ->
      typed ctxt loc Nop stack
  | (Seq (loc, [single]), stack) -> (
      parse_instr ?type_logger tc_context ctxt ~legacy single stack
      >>=? fun (judgement, ctxt) ->
      match judgement with
      | Typed ({aft; _} as instr) ->
          let nop = {bef = aft; loc; aft; instr = Nop} in
          typed ctxt loc (Seq (instr, nop)) aft
      | Failed {descr; _} ->
          let descr aft =
            let nop = {bef = aft; loc; aft; instr = Nop} in
            let descr = descr aft in
            {descr with instr = Seq (descr, nop)}
          in
          return ctxt (Failed {descr}) )
  | (Seq (loc, hd :: tl), stack) -> (
      parse_instr ?type_logger tc_context ctxt ~legacy hd stack
      >>=? fun (judgement, ctxt) ->
      match judgement with
      | Failed _ ->
          fail (Fail_not_in_tail_position (Micheline.location hd))
      | Typed ({aft = middle; _} as ihd) -> (
          parse_instr
            ?type_logger
            tc_context
            ctxt
            ~legacy
            (Seq (-1, tl))
            middle
          >>=? fun (judgement, ctxt) ->
          match judgement with
          | Failed {descr} ->
              let descr ret =
                {loc; instr = Seq (ihd, descr ret); bef = stack; aft = ret}
              in
              return ctxt (Failed {descr})
          | Typed itl ->
              typed ctxt loc (Seq (ihd, itl)) itl.aft ) )
  | (Prim (loc, I_IF, [bt; bf], annot), (Item_t (Bool_t _, rest, _) as bef)) ->
      check_kind [Seq_kind] bt
      >>=? fun () ->
      check_kind [Seq_kind] bf
      >>=? fun () ->
      fail_unexpected_annot loc annot
      >>=? fun () ->
      parse_instr ?type_logger tc_context ctxt ~legacy bt rest
      >>=? fun (btr, ctxt) ->
      parse_instr ?type_logger tc_context ctxt ~legacy bf rest
      >>=? fun (bfr, ctxt) ->
      let branch ibt ibf = {loc; instr = If (ibt, ibf); bef; aft = ibt.aft} in
      merge_branches ~legacy ctxt loc btr bfr {branch}
      >>=? fun (judgement, ctxt) -> return ctxt judgement
  | ( Prim (loc, I_LOOP, [body], annot),
      (Item_t (Bool_t _, rest, _stack_annot) as stack) ) -> (
      check_kind [Seq_kind] body
      >>=? fun () ->
      fail_unexpected_annot loc annot
      >>=? fun () ->
      parse_instr ?type_logger tc_context ctxt ~legacy body rest
      >>=? fun (judgement, ctxt) ->
      match judgement with
      | Typed ibody ->
          let unmatched_branches () =
            serialize_stack_for_error ctxt ibody.aft
            >>=? fun (aft, ctxt) ->
            serialize_stack_for_error ctxt stack
            >>|? fun (stack, _ctxt) -> Unmatched_branches (loc, aft, stack)
          in
          trace_eval
            unmatched_branches
            ( Lwt.return @@ stack_ty_eq ctxt 1 ibody.aft stack
            >>=? fun (Eq, ctxt) ->
            Lwt.return @@ merge_stacks ~legacy loc ctxt ibody.aft stack
            >>=? fun (_stack, ctxt) -> typed ctxt loc (Loop ibody) rest )
      | Failed {descr} ->
          let ibody = descr stack in
          typed ctxt loc (Loop ibody) rest )
  | ( Prim (loc, I_LOOP_LEFT, [body], annot),
      ( Item_t (Union_t ((tl, l_field), (tr, _), _, _), rest, union_annot) as
      stack ) ) -> (
      check_kind [Seq_kind] body
      >>=? fun () ->
      parse_var_annot loc annot
      >>=? fun annot ->
      let l_annot =
        gen_access_annot union_annot l_field ~default:default_left_annot
      in
      parse_instr
        ?type_logger
        tc_context
        ctxt
        ~legacy
        body
        (Item_t (tl, rest, l_annot))
      >>=? fun (judgement, ctxt) ->
      match judgement with
      | Typed ibody ->
          let unmatched_branches () =
            serialize_stack_for_error ctxt ibody.aft
            >>=? fun (aft, ctxt) ->
            serialize_stack_for_error ctxt stack
            >>|? fun (stack, _ctxt) -> Unmatched_branches (loc, aft, stack)
          in
          trace_eval
            unmatched_branches
            ( Lwt.return @@ stack_ty_eq ctxt 1 ibody.aft stack
            >>=? fun (Eq, ctxt) ->
            Lwt.return @@ merge_stacks ~legacy loc ctxt ibody.aft stack
            >>=? fun (_stack, ctxt) ->
            typed ctxt loc (Loop_left ibody) (Item_t (tr, rest, annot)) )
      | Failed {descr} ->
          let ibody = descr stack in
          typed ctxt loc (Loop_left ibody) (Item_t (tr, rest, annot)) )
  | (Prim (loc, I_LAMBDA, [arg; ret; code], annot), stack) ->
      Lwt.return @@ parse_any_ty ctxt ~legacy arg
      >>=? fun (Ex_ty arg, ctxt) ->
      Lwt.return @@ parse_any_ty ctxt ~legacy ret
      >>=? fun (Ex_ty ret, ctxt) ->
      check_kind [Seq_kind] code
      >>=? fun () ->
      parse_var_annot loc annot
      >>=? fun annot ->
      parse_returning
        Lambda
        ?type_logger
        ctxt
        ~legacy
        (arg, default_arg_annot)
        ret
        code
      >>=? fun (lambda, ctxt) ->
      typed
        ctxt
        loc
        (Lambda lambda)
        (Item_t (Lambda_t (arg, ret, None), stack, annot))
  | ( Prim (loc, I_EXEC, [], annot),
      Item_t (arg, Item_t (Lambda_t (param, ret, _), rest, _), _) ) ->
      check_item_ty ctxt arg param loc I_EXEC 1 2
      >>=? fun (Eq, _, ctxt) ->
      parse_var_annot loc annot
      >>=? fun annot -> typed ctxt loc Exec (Item_t (ret, rest, annot))
  | ( Prim (loc, I_APPLY, [], annot),
      Item_t
        ( capture,
          Item_t
            ( Lambda_t
                ( Pair_t ((capture_ty, _, _), (arg_ty, _, _), lam_annot, _),
                  ret,
                  _ ),
              rest,
              _ ),
          _ ) ) ->
      Lwt.return @@ check_packable ~legacy:false loc capture_ty
      >>=? fun () ->
      check_item_ty ctxt capture capture_ty loc I_APPLY 1 2
      >>=? fun (Eq, capture_ty, ctxt) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      typed
        ctxt
        loc
        (Apply capture_ty)
        (Item_t (Lambda_t (arg_ty, ret, lam_annot), rest, annot))
  | (Prim (loc, I_DIP, [code], annot), Item_t (v, rest, stack_annot)) -> (
      fail_unexpected_annot loc annot
      >>=? fun () ->
      check_kind [Seq_kind] code
      >>=? fun () ->
      parse_instr
        ?type_logger
        (add_dip v stack_annot tc_context)
        ctxt
        ~legacy
        code
        rest
      >>=? fun (judgement, ctxt) ->
      match judgement with
      | Typed descr ->
          typed ctxt loc (Dip descr) (Item_t (v, descr.aft, stack_annot))
      | Failed _ ->
          fail (Fail_not_in_tail_position loc) )
  | (Prim (loc, I_DIP, [n; code], result_annot), stack)
    when match parse_int32 n with Ok _ -> true | Error _ -> false ->
      let rec make_proof_argument :
          type tstk.
          int
          (* -> (fbef stack_ty -> (fbef judgement * context) tzresult Lwt.t) *) ->
          tc_context ->
          tstk stack_ty ->
          tstk dipn_proof_argument tzresult Lwt.t =
       fun n inner_tc_context stk ->
        match (Compare.Int.(n = 0), stk) with
        | (true, rest) -> (
            parse_instr ?type_logger inner_tc_context ctxt ~legacy code rest
            >>=? fun (judgement, ctxt) ->
            match judgement with
            | Typed descr ->
                outer_return
                @@ Dipn_proof_argument (Rest, (ctxt, descr), descr.aft)
            | Failed _ ->
                fail (Fail_not_in_tail_position loc) )
        | (false, Item_t (v, rest, annot)) ->
            make_proof_argument (n - 1) (add_dip v annot tc_context) rest
            >>=? fun (Dipn_proof_argument (n', descr, aft')) ->
            outer_return
            @@ Dipn_proof_argument (Prefix n', descr, Item_t (v, aft', annot))
        | (_, _) ->
            serialize_stack_for_error ctxt stack
            >>=? fun (whole_stack, _ctxt) ->
            fail (Bad_stack (loc, I_DIP, 1, whole_stack))
      in
      Lwt.return (parse_int32 n)
      >>=? fun n ->
      fail_unexpected_annot loc result_annot
      >>=? fun () ->
      make_proof_argument n tc_context stack
      >>=? fun (Dipn_proof_argument (n', (new_ctxt, descr), aft)) ->
      (* TODO: which context should be used in the next line? new_ctxt or the old ctxt? *)
      typed new_ctxt loc (Dipn (n, n', descr)) aft
  | (Prim (loc, I_DIP, (([] | _ :: _ :: _ :: _) as l), _), _) ->
      (* Technically, the arities 1 and 2 are allowed but the error only mentions 2.
           However, DIP {code} is equivalent to DIP 1 {code} so hinting at an arity of 2 makes sense. *)
      fail (Invalid_arity (loc, I_DIP, 2, List.length l))
  | (Prim (loc, I_FAILWITH, [], annot), Item_t (v, _rest, _)) ->
      fail_unexpected_annot loc annot
      >>=? fun () ->
      let descr aft = {loc; instr = Failwith v; bef = stack_ty; aft} in
      log_stack ctxt loc stack_ty Empty_t
      >>=? fun () -> return ctxt (Failed {descr})
  (* timestamp operations *)
  | ( Prim (loc, I_ADD, [], annot),
      Item_t (Timestamp_t tname, Item_t (Int_t _, rest, _), _) ) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      typed
        ctxt
        loc
        Add_timestamp_to_seconds
        (Item_t (Timestamp_t tname, rest, annot))
  | ( Prim (loc, I_ADD, [], annot),
      Item_t (Int_t _, Item_t (Timestamp_t tname, rest, _), _) ) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      typed
        ctxt
        loc
        Add_seconds_to_timestamp
        (Item_t (Timestamp_t tname, rest, annot))
  | ( Prim (loc, I_SUB, [], annot),
      Item_t (Timestamp_t tname, Item_t (Int_t _, rest, _), _) ) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      typed
        ctxt
        loc
        Sub_timestamp_seconds
        (Item_t (Timestamp_t tname, rest, annot))
  | ( Prim (loc, I_SUB, [], annot),
      Item_t (Timestamp_t tn1, Item_t (Timestamp_t tn2, rest, _), _) ) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      Lwt.return @@ merge_type_annot ~legacy tn1 tn2
      >>=? fun tname ->
      typed ctxt loc Diff_timestamps (Item_t (Int_t tname, rest, annot))
  (* string operations *)
  | ( Prim (loc, I_CONCAT, [], annot),
      Item_t (String_t tn1, Item_t (String_t tn2, rest, _), _) ) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      Lwt.return @@ merge_type_annot ~legacy tn1 tn2
      >>=? fun tname ->
      typed ctxt loc Concat_string_pair (Item_t (String_t tname, rest, annot))
  | ( Prim (loc, I_CONCAT, [], annot),
      Item_t (List_t (String_t tname, _, _), rest, list_annot) ) ->
      parse_var_annot ~default:list_annot loc annot
      >>=? fun annot ->
      typed ctxt loc Concat_string (Item_t (String_t tname, rest, annot))
  | ( Prim (loc, I_SLICE, [], annot),
      Item_t
        ( Nat_t _,
          Item_t (Nat_t _, Item_t (String_t tname, rest, string_annot), _),
          _ ) ) ->
      parse_var_annot
        ~default:(gen_access_annot string_annot default_slice_annot)
        loc
        annot
      >>=? fun annot ->
      typed
        ctxt
        loc
        Slice_string
        (Item_t (Option_t (String_t tname, None, false), rest, annot))
  | (Prim (loc, I_SIZE, [], annot), Item_t (String_t _, rest, _)) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      typed ctxt loc String_size (Item_t (Nat_t None, rest, annot))
  (* bytes operations *)
  | ( Prim (loc, I_CONCAT, [], annot),
      Item_t (Bytes_t tn1, Item_t (Bytes_t tn2, rest, _), _) ) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      Lwt.return @@ merge_type_annot ~legacy tn1 tn2
      >>=? fun tname ->
      typed ctxt loc Concat_bytes_pair (Item_t (Bytes_t tname, rest, annot))
  | ( Prim (loc, I_CONCAT, [], annot),
      Item_t (List_t (Bytes_t tname, _, _), rest, list_annot) ) ->
      parse_var_annot ~default:list_annot loc annot
      >>=? fun annot ->
      typed ctxt loc Concat_bytes (Item_t (Bytes_t tname, rest, annot))
  | ( Prim (loc, I_SLICE, [], annot),
      Item_t
        ( Nat_t _,
          Item_t (Nat_t _, Item_t (Bytes_t tname, rest, bytes_annot), _),
          _ ) ) ->
      parse_var_annot
        ~default:(gen_access_annot bytes_annot default_slice_annot)
        loc
        annot
      >>=? fun annot ->
      typed
        ctxt
        loc
        Slice_bytes
        (Item_t (Option_t (Bytes_t tname, None, false), rest, annot))
  | (Prim (loc, I_SIZE, [], annot), Item_t (Bytes_t _, rest, _)) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      typed ctxt loc Bytes_size (Item_t (Nat_t None, rest, annot))
  (* currency operations *)
  | ( Prim (loc, I_ADD, [], annot),
      Item_t (Mutez_t tn1, Item_t (Mutez_t tn2, rest, _), _) ) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      Lwt.return @@ merge_type_annot ~legacy tn1 tn2
      >>=? fun tname ->
      typed ctxt loc Add_tez (Item_t (Mutez_t tname, rest, annot))
  | ( Prim (loc, I_SUB, [], annot),
      Item_t (Mutez_t tn1, Item_t (Mutez_t tn2, rest, _), _) ) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      Lwt.return @@ merge_type_annot ~legacy tn1 tn2
      >>=? fun tname ->
      typed ctxt loc Sub_tez (Item_t (Mutez_t tname, rest, annot))
  | ( Prim (loc, I_MUL, [], annot),
      Item_t (Mutez_t tname, Item_t (Nat_t _, rest, _), _) ) ->
      (* no type name check *)
      parse_var_annot loc annot
      >>=? fun annot ->
      typed ctxt loc Mul_teznat (Item_t (Mutez_t tname, rest, annot))
  | ( Prim (loc, I_MUL, [], annot),
      Item_t (Nat_t _, Item_t (Mutez_t tname, rest, _), _) ) ->
      (* no type name check *)
      parse_var_annot loc annot
      >>=? fun annot ->
      typed ctxt loc Mul_nattez (Item_t (Mutez_t tname, rest, annot))
  (* boolean operations *)
  | ( Prim (loc, I_OR, [], annot),
      Item_t (Bool_t tn1, Item_t (Bool_t tn2, rest, _), _) ) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      Lwt.return @@ merge_type_annot ~legacy tn1 tn2
      >>=? fun tname -> typed ctxt loc Or (Item_t (Bool_t tname, rest, annot))
  | ( Prim (loc, I_AND, [], annot),
      Item_t (Bool_t tn1, Item_t (Bool_t tn2, rest, _), _) ) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      Lwt.return @@ merge_type_annot ~legacy tn1 tn2
      >>=? fun tname -> typed ctxt loc And (Item_t (Bool_t tname, rest, annot))
  | ( Prim (loc, I_XOR, [], annot),
      Item_t (Bool_t tn1, Item_t (Bool_t tn2, rest, _), _) ) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      Lwt.return @@ merge_type_annot ~legacy tn1 tn2
      >>=? fun tname -> typed ctxt loc Xor (Item_t (Bool_t tname, rest, annot))
  | (Prim (loc, I_NOT, [], annot), Item_t (Bool_t tname, rest, _)) ->
      parse_var_annot loc annot
      >>=? fun annot -> typed ctxt loc Not (Item_t (Bool_t tname, rest, annot))
  (* integer operations *)
  | (Prim (loc, I_ABS, [], annot), Item_t (Int_t _, rest, _)) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      typed ctxt loc Abs_int (Item_t (Nat_t None, rest, annot))
  | (Prim (loc, I_ISNAT, [], annot), Item_t (Int_t _, rest, int_annot)) ->
      parse_var_annot loc annot ~default:int_annot
      >>=? fun annot ->
      typed
        ctxt
        loc
        Is_nat
        (Item_t (Option_t (Nat_t None, None, false), rest, annot))
  | (Prim (loc, I_INT, [], annot), Item_t (Nat_t _, rest, _)) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      typed ctxt loc Int_nat (Item_t (Int_t None, rest, annot))
  | (Prim (loc, I_NEG, [], annot), Item_t (Int_t tname, rest, _)) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      typed ctxt loc Neg_int (Item_t (Int_t tname, rest, annot))
  | (Prim (loc, I_NEG, [], annot), Item_t (Nat_t _, rest, _)) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      typed ctxt loc Neg_nat (Item_t (Int_t None, rest, annot))
  | ( Prim (loc, I_ADD, [], annot),
      Item_t (Int_t tn1, Item_t (Int_t tn2, rest, _), _) ) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      Lwt.return @@ merge_type_annot ~legacy tn1 tn2
      >>=? fun tname ->
      typed ctxt loc Add_intint (Item_t (Int_t tname, rest, annot))
  | ( Prim (loc, I_ADD, [], annot),
      Item_t (Int_t tname, Item_t (Nat_t _, rest, _), _) ) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      typed ctxt loc Add_intnat (Item_t (Int_t tname, rest, annot))
  | ( Prim (loc, I_ADD, [], annot),
      Item_t (Nat_t _, Item_t (Int_t tname, rest, _), _) ) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      typed ctxt loc Add_natint (Item_t (Int_t tname, rest, annot))
  | ( Prim (loc, I_ADD, [], annot),
      Item_t (Nat_t tn1, Item_t (Nat_t tn2, rest, _), _) ) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      Lwt.return @@ merge_type_annot ~legacy tn1 tn2
      >>=? fun tname ->
      typed ctxt loc Add_natnat (Item_t (Nat_t tname, rest, annot))
  | ( Prim (loc, I_SUB, [], annot),
      Item_t (Int_t tn1, Item_t (Int_t tn2, rest, _), _) ) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      Lwt.return @@ merge_type_annot ~legacy tn1 tn2
      >>=? fun tname ->
      typed ctxt loc Sub_int (Item_t (Int_t tname, rest, annot))
  | ( Prim (loc, I_SUB, [], annot),
      Item_t (Int_t tname, Item_t (Nat_t _, rest, _), _) ) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      typed ctxt loc Sub_int (Item_t (Int_t tname, rest, annot))
  | ( Prim (loc, I_SUB, [], annot),
      Item_t (Nat_t _, Item_t (Int_t tname, rest, _), _) ) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      typed ctxt loc Sub_int (Item_t (Int_t tname, rest, annot))
  | ( Prim (loc, I_SUB, [], annot),
      Item_t (Nat_t tn1, Item_t (Nat_t tn2, rest, _), _) ) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      Lwt.return @@ merge_type_annot ~legacy tn1 tn2
      >>=? fun _tname ->
      typed ctxt loc Sub_int (Item_t (Int_t None, rest, annot))
  | ( Prim (loc, I_MUL, [], annot),
      Item_t (Int_t tn1, Item_t (Int_t tn2, rest, _), _) ) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      Lwt.return @@ merge_type_annot ~legacy tn1 tn2
      >>=? fun tname ->
      typed ctxt loc Mul_intint (Item_t (Int_t tname, rest, annot))
  | ( Prim (loc, I_MUL, [], annot),
      Item_t (Int_t tname, Item_t (Nat_t _, rest, _), _) ) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      typed ctxt loc Mul_intnat (Item_t (Int_t tname, rest, annot))
  | ( Prim (loc, I_MUL, [], annot),
      Item_t (Nat_t _, Item_t (Int_t tname, rest, _), _) ) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      typed ctxt loc Mul_natint (Item_t (Int_t tname, rest, annot))
  | ( Prim (loc, I_MUL, [], annot),
      Item_t (Nat_t tn1, Item_t (Nat_t tn2, rest, _), _) ) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      Lwt.return @@ merge_type_annot ~legacy tn1 tn2
      >>=? fun tname ->
      typed ctxt loc Mul_natnat (Item_t (Nat_t tname, rest, annot))
  | ( Prim (loc, I_EDIV, [], annot),
      Item_t (Mutez_t tname, Item_t (Nat_t _, rest, _), _) ) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      typed
        ctxt
        loc
        Ediv_teznat
        (Item_t
           ( Option_t
               ( Pair_t
                   ( (Mutez_t tname, None, None),
                     (Mutez_t tname, None, None),
                     None,
                     false ),
                 None,
                 false ),
             rest,
             annot ))
  | ( Prim (loc, I_EDIV, [], annot),
      Item_t (Mutez_t tn1, Item_t (Mutez_t tn2, rest, _), _) ) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      Lwt.return @@ merge_type_annot ~legacy tn1 tn2
      >>=? fun tname ->
      typed
        ctxt
        loc
        Ediv_tez
        (Item_t
           ( Option_t
               ( Pair_t
                   ( (Nat_t None, None, None),
                     (Mutez_t tname, None, None),
                     None,
                     false ),
                 None,
                 false ),
             rest,
             annot ))
  | ( Prim (loc, I_EDIV, [], annot),
      Item_t (Int_t tn1, Item_t (Int_t tn2, rest, _), _) ) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      Lwt.return @@ merge_type_annot ~legacy tn1 tn2
      >>=? fun tname ->
      typed
        ctxt
        loc
        Ediv_intint
        (Item_t
           ( Option_t
               ( Pair_t
                   ( (Int_t tname, None, None),
                     (Nat_t None, None, None),
                     None,
                     false ),
                 None,
                 false ),
             rest,
             annot ))
  | ( Prim (loc, I_EDIV, [], annot),
      Item_t (Int_t tname, Item_t (Nat_t _, rest, _), _) ) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      typed
        ctxt
        loc
        Ediv_intnat
        (Item_t
           ( Option_t
               ( Pair_t
                   ( (Int_t tname, None, None),
                     (Nat_t None, None, None),
                     None,
                     false ),
                 None,
                 false ),
             rest,
             annot ))
  | ( Prim (loc, I_EDIV, [], annot),
      Item_t (Nat_t tname, Item_t (Int_t _, rest, _), _) ) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      typed
        ctxt
        loc
        Ediv_natint
        (Item_t
           ( Option_t
               ( Pair_t
                   ( (Int_t None, None, None),
                     (Nat_t tname, None, None),
                     None,
                     false ),
                 None,
                 false ),
             rest,
             annot ))
  | ( Prim (loc, I_EDIV, [], annot),
      Item_t (Nat_t tn1, Item_t (Nat_t tn2, rest, _), _) ) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      Lwt.return @@ merge_type_annot ~legacy tn1 tn2
      >>=? fun tname ->
      typed
        ctxt
        loc
        Ediv_natnat
        (Item_t
           ( Option_t
               ( Pair_t
                   ( (Nat_t tname, None, None),
                     (Nat_t tname, None, None),
                     None,
                     false ),
                 None,
                 false ),
             rest,
             annot ))
  | ( Prim (loc, I_LSL, [], annot),
      Item_t (Nat_t tn1, Item_t (Nat_t tn2, rest, _), _) ) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      Lwt.return @@ merge_type_annot ~legacy tn1 tn2
      >>=? fun tname ->
      typed ctxt loc Lsl_nat (Item_t (Nat_t tname, rest, annot))
  | ( Prim (loc, I_LSR, [], annot),
      Item_t (Nat_t tn1, Item_t (Nat_t tn2, rest, _), _) ) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      Lwt.return @@ merge_type_annot ~legacy tn1 tn2
      >>=? fun tname ->
      typed ctxt loc Lsr_nat (Item_t (Nat_t tname, rest, annot))
  | ( Prim (loc, I_OR, [], annot),
      Item_t (Nat_t tn1, Item_t (Nat_t tn2, rest, _), _) ) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      Lwt.return @@ merge_type_annot ~legacy tn1 tn2
      >>=? fun tname ->
      typed ctxt loc Or_nat (Item_t (Nat_t tname, rest, annot))
  | ( Prim (loc, I_AND, [], annot),
      Item_t (Nat_t tn1, Item_t (Nat_t tn2, rest, _), _) ) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      Lwt.return @@ merge_type_annot ~legacy tn1 tn2
      >>=? fun tname ->
      typed ctxt loc And_nat (Item_t (Nat_t tname, rest, annot))
  | ( Prim (loc, I_AND, [], annot),
      Item_t (Int_t _, Item_t (Nat_t tname, rest, _), _) ) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      typed ctxt loc And_int_nat (Item_t (Nat_t tname, rest, annot))
  | ( Prim (loc, I_XOR, [], annot),
      Item_t (Nat_t tn1, Item_t (Nat_t tn2, rest, _), _) ) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      Lwt.return @@ merge_type_annot ~legacy tn1 tn2
      >>=? fun tname ->
      typed ctxt loc Xor_nat (Item_t (Nat_t tname, rest, annot))
  | (Prim (loc, I_NOT, [], annot), Item_t (Int_t tname, rest, _)) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      typed ctxt loc Not_int (Item_t (Int_t tname, rest, annot))
  | (Prim (loc, I_NOT, [], annot), Item_t (Nat_t _, rest, _)) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      typed ctxt loc Not_nat (Item_t (Int_t None, rest, annot))
  (* comparison *)
  | (Prim (loc, I_COMPARE, [], annot), Item_t (t1, Item_t (t2, rest, _), _))
    -> (
      parse_var_annot loc annot
      >>=? fun annot ->
      check_item_ty ctxt t1 t2 loc I_COMPARE 1 2
      >>=? fun (Eq, t, ctxt) ->
      match comparable_ty_of_ty t with
      | None ->
          Lwt.return (serialize_ty_for_error ctxt t)
          >>=? fun (t, _ctxt) -> fail (Comparable_type_expected (loc, t))
      | Some key ->
          typed ctxt loc (Compare key) (Item_t (Int_t None, rest, annot)) )
  (* comparators *)
  | (Prim (loc, I_EQ, [], annot), Item_t (Int_t _, rest, _)) ->
      parse_var_annot loc annot
      >>=? fun annot -> typed ctxt loc Eq (Item_t (Bool_t None, rest, annot))
  | (Prim (loc, I_NEQ, [], annot), Item_t (Int_t _, rest, _)) ->
      parse_var_annot loc annot
      >>=? fun annot -> typed ctxt loc Neq (Item_t (Bool_t None, rest, annot))
  | (Prim (loc, I_LT, [], annot), Item_t (Int_t _, rest, _)) ->
      parse_var_annot loc annot
      >>=? fun annot -> typed ctxt loc Lt (Item_t (Bool_t None, rest, annot))
  | (Prim (loc, I_GT, [], annot), Item_t (Int_t _, rest, _)) ->
      parse_var_annot loc annot
      >>=? fun annot -> typed ctxt loc Gt (Item_t (Bool_t None, rest, annot))
  | (Prim (loc, I_LE, [], annot), Item_t (Int_t _, rest, _)) ->
      parse_var_annot loc annot
      >>=? fun annot -> typed ctxt loc Le (Item_t (Bool_t None, rest, annot))
  | (Prim (loc, I_GE, [], annot), Item_t (Int_t _, rest, _)) ->
      parse_var_annot loc annot
      >>=? fun annot -> typed ctxt loc Ge (Item_t (Bool_t None, rest, annot))
  (* annotations *)
  | (Prim (loc, I_CAST, [cast_t], annot), Item_t (t, stack, item_annot)) ->
      parse_var_annot loc annot ~default:item_annot
      >>=? fun annot ->
      Lwt.return @@ parse_any_ty ctxt ~legacy cast_t
      >>=? fun (Ex_ty cast_t, ctxt) ->
      Lwt.return @@ ty_eq ctxt cast_t t
      >>=? fun (Eq, ctxt) ->
      Lwt.return @@ merge_types ~legacy ctxt loc cast_t t
      >>=? fun (_, ctxt) -> typed ctxt loc Nop (Item_t (cast_t, stack, annot))
  | (Prim (loc, I_RENAME, [], annot), Item_t (t, stack, _)) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      (* can erase annot *)
      typed ctxt loc Nop (Item_t (t, stack, annot))
  (* packing *)
  | (Prim (loc, I_PACK, [], annot), Item_t (t, rest, unpacked_annot)) ->
      Lwt.return
        (check_packable
           ~legacy:true
           (* allow to pack contracts for hash/signature checks *) loc
           t)
      >>=? fun () ->
      parse_var_annot
        loc
        annot
        ~default:(gen_access_annot unpacked_annot default_pack_annot)
      >>=? fun annot ->
      typed ctxt loc (Pack t) (Item_t (Bytes_t None, rest, annot))
  | (Prim (loc, I_UNPACK, [ty], annot), Item_t (Bytes_t _, rest, packed_annot))
    ->
      Lwt.return @@ parse_packable_ty ctxt ~legacy ty
      >>=? fun (Ex_ty t, ctxt) ->
      parse_var_type_annot loc annot
      >>=? fun (annot, ty_name) ->
      let annot =
        default_annot
          annot
          ~default:(gen_access_annot packed_annot default_unpack_annot)
      in
      typed
        ctxt
        loc
        (Unpack t)
        (Item_t
           ( Option_t (t, ty_name, false (* cannot unpack big_maps *)),
             rest,
             annot ))
  (* protocol *)
  | ( Prim (loc, I_ADDRESS, [], annot),
      Item_t (Contract_t _, rest, contract_annot) ) ->
      parse_var_annot
        loc
        annot
        ~default:(gen_access_annot contract_annot default_addr_annot)
      >>=? fun annot ->
      typed ctxt loc Address (Item_t (Address_t None, rest, annot))
  | ( Prim (loc, I_CONTRACT, [ty], annot),
      Item_t (Address_t _, rest, addr_annot) ) ->
      Lwt.return @@ parse_parameter_ty ctxt ~legacy ty
      >>=? fun (Ex_ty t, ctxt) ->
      parse_entrypoint_annot
        loc
        annot
        ~default:(gen_access_annot addr_annot default_contract_annot)
      >>=? fun (annot, entrypoint) ->
      ( Lwt.return
      @@
      match entrypoint with
      | None ->
          Ok "default"
      | Some (`Field_annot "default") ->
          error (Unexpected_annotation loc)
      | Some (`Field_annot entrypoint) ->
          if Compare.Int.(String.length entrypoint > 31) then
            error (Entrypoint_name_too_long entrypoint)
          else Ok entrypoint )
      >>=? fun entrypoint ->
      typed
        ctxt
        loc
        (Contract (t, entrypoint))
        (Item_t (Option_t (Contract_t (t, None), None, false), rest, annot))
  | ( Prim (loc, I_TRANSFER_TOKENS, [], annot),
      Item_t (p, Item_t (Mutez_t _, Item_t (Contract_t (cp, _), rest, _), _), _)
    ) ->
      check_item_ty ctxt p cp loc I_TRANSFER_TOKENS 1 4
      >>=? fun (Eq, _, ctxt) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      typed ctxt loc Transfer_tokens (Item_t (Operation_t None, rest, annot))
  | ( Prim (loc, I_SET_DELEGATE, [], annot),
      Item_t (Option_t (Key_hash_t _, _, _), rest, _) ) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      typed ctxt loc Set_delegate (Item_t (Operation_t None, rest, annot))
  | ( Prim (loc, I_CREATE_ACCOUNT, [], annot),
      Item_t
        ( Key_hash_t _,
          Item_t
            ( Option_t (Key_hash_t _, _, _),
              Item_t (Bool_t _, Item_t (Mutez_t _, rest, _), _),
              _ ),
          _ ) ) ->
      if legacy then
        (* For existing contracts, this instruction is still allowed *)
        parse_two_var_annot loc annot
        >>=? fun (op_annot, addr_annot) ->
        typed
          ctxt
          loc
          Create_account
          (Item_t
             ( Operation_t None,
               Item_t (Address_t None, rest, addr_annot),
               op_annot ))
      else
        (* For new contracts this instruction is not allowed anymore *)
        fail (Deprecated_instruction I_CREATE_ACCOUNT)
  | (Prim (loc, I_IMPLICIT_ACCOUNT, [], annot), Item_t (Key_hash_t _, rest, _))
    ->
      parse_var_annot loc annot
      >>=? fun annot ->
      typed
        ctxt
        loc
        Implicit_account
        (Item_t (Contract_t (Unit_t None, None), rest, annot))
  | ( Prim (loc, I_CREATE_CONTRACT, [(Seq _ as code)], annot),
      Item_t
        ( Key_hash_t _,
          Item_t
            ( Option_t (Key_hash_t _, _, _),
              Item_t
                ( Bool_t _,
                  Item_t
                    ( Bool_t _,
                      Item_t (Mutez_t _, Item_t (ginit, rest, _), _),
                      _ ),
                  _ ),
              _ ),
          _ ) ) ->
      if legacy then
        (* For existing contracts, this instruction is still allowed *)
        parse_two_var_annot loc annot
        >>=? fun (op_annot, addr_annot) ->
        let cannonical_code = fst @@ Micheline.extract_locations code in
        Lwt.return @@ parse_toplevel ~legacy cannonical_code
        >>=? fun (arg_type, storage_type, code_field, root_name) ->
        trace
          (Ill_formed_type
             (Some "parameter", cannonical_code, location arg_type))
          (Lwt.return @@ parse_parameter_ty ctxt ~legacy arg_type)
        >>=? fun (Ex_ty arg_type, ctxt) ->
        ( if legacy then Error_monad.return ()
        else Lwt.return (well_formed_entrypoints ~root_name arg_type) )
        >>=? fun () ->
        trace
          (Ill_formed_type
             (Some "storage", cannonical_code, location storage_type))
          (Lwt.return @@ parse_storage_ty ctxt ~legacy storage_type)
        >>=? fun (Ex_ty storage_type, ctxt) ->
        let arg_annot =
          default_annot
            (type_to_var_annot (name_of_ty arg_type))
            ~default:default_param_annot
        in
        let storage_annot =
          default_annot
            (type_to_var_annot (name_of_ty storage_type))
            ~default:default_storage_annot
        in
        let arg_type_full =
          Pair_t
            ( (arg_type, None, arg_annot),
              (storage_type, None, storage_annot),
              None,
              has_big_map arg_type || has_big_map storage_type )
        in
        let ret_type_full =
          Pair_t
            ( (List_t (Operation_t None, None, false), None, None),
              (storage_type, None, None),
              None,
              has_big_map storage_type )
        in
        trace
          (Ill_typed_contract (cannonical_code, []))
          (parse_returning
             (Toplevel
                {
                  storage_type;
                  param_type = arg_type;
                  root_name;
                  legacy_create_contract_literal = true;
                })
             ctxt
             ~legacy
             ?type_logger
             (arg_type_full, None)
             ret_type_full
             code_field)
        >>=? fun ( ( Lam
                       ( { bef = Item_t (arg, Empty_t, _);
                           aft = Item_t (ret, Empty_t, _);
                           _ },
                         _ ) as lambda ),
                   ctxt ) ->
        Lwt.return @@ ty_eq ctxt arg arg_type_full
        >>=? fun (Eq, ctxt) ->
        Lwt.return @@ merge_types ~legacy ctxt loc arg arg_type_full
        >>=? fun (_, ctxt) ->
        Lwt.return @@ ty_eq ctxt ret ret_type_full
        >>=? fun (Eq, ctxt) ->
        Lwt.return @@ merge_types ~legacy ctxt loc ret ret_type_full
        >>=? fun (_, ctxt) ->
        Lwt.return @@ ty_eq ctxt storage_type ginit
        >>=? fun (Eq, ctxt) ->
        Lwt.return @@ merge_types ~legacy ctxt loc storage_type ginit
        >>=? fun (_, ctxt) ->
        typed
          ctxt
          loc
          (Create_contract (storage_type, arg_type, lambda, root_name))
          (Item_t
             ( Operation_t None,
               Item_t (Address_t None, rest, addr_annot),
               op_annot ))
      else
        (* For new contracts this instruction is not allowed anymore *)
        fail (Deprecated_instruction I_CREATE_CONTRACT)
  | ( Prim (loc, I_CREATE_CONTRACT, [(Seq _ as code)], annot),
      (* Removed the instruction's arguments manager, spendable and delegatable *)
    Item_t
      ( Option_t (Key_hash_t _, _, _),
        Item_t (Mutez_t _, Item_t (ginit, rest, _), _),
        _ ) ) ->
      parse_two_var_annot loc annot
      >>=? fun (op_annot, addr_annot) ->
      let cannonical_code = fst @@ Micheline.extract_locations code in
      Lwt.return @@ parse_toplevel ~legacy cannonical_code
      >>=? fun (arg_type, storage_type, code_field, root_name) ->
      trace
        (Ill_formed_type (Some "parameter", cannonical_code, location arg_type))
        (Lwt.return @@ parse_parameter_ty ctxt ~legacy arg_type)
      >>=? fun (Ex_ty arg_type, ctxt) ->
      ( if legacy then Error_monad.return ()
      else Lwt.return (well_formed_entrypoints ~root_name arg_type) )
      >>=? fun () ->
      trace
        (Ill_formed_type
           (Some "storage", cannonical_code, location storage_type))
        (Lwt.return @@ parse_storage_ty ctxt ~legacy storage_type)
      >>=? fun (Ex_ty storage_type, ctxt) ->
      let arg_annot =
        default_annot
          (type_to_var_annot (name_of_ty arg_type))
          ~default:default_param_annot
      in
      let storage_annot =
        default_annot
          (type_to_var_annot (name_of_ty storage_type))
          ~default:default_storage_annot
      in
      let arg_type_full =
        Pair_t
          ( (arg_type, None, arg_annot),
            (storage_type, None, storage_annot),
            None,
            has_big_map arg_type || has_big_map storage_type )
      in
      let ret_type_full =
        Pair_t
          ( (List_t (Operation_t None, None, false), None, None),
            (storage_type, None, None),
            None,
            has_big_map storage_type )
      in
      trace
        (Ill_typed_contract (cannonical_code, []))
        (parse_returning
           (Toplevel
              {
                storage_type;
                param_type = arg_type;
                root_name;
                legacy_create_contract_literal = false;
              })
           ctxt
           ~legacy
           ?type_logger
           (arg_type_full, None)
           ret_type_full
           code_field)
      >>=? fun ( ( Lam
                     ( { bef = Item_t (arg, Empty_t, _);
                         aft = Item_t (ret, Empty_t, _);
                         _ },
                       _ ) as lambda ),
                 ctxt ) ->
      Lwt.return @@ ty_eq ctxt arg arg_type_full
      >>=? fun (Eq, ctxt) ->
      Lwt.return @@ merge_types ~legacy ctxt loc arg arg_type_full
      >>=? fun (_, ctxt) ->
      Lwt.return @@ ty_eq ctxt ret ret_type_full
      >>=? fun (Eq, ctxt) ->
      Lwt.return @@ merge_types ~legacy ctxt loc ret ret_type_full
      >>=? fun (_, ctxt) ->
      Lwt.return @@ ty_eq ctxt storage_type ginit
      >>=? fun (Eq, ctxt) ->
      Lwt.return @@ merge_types ~legacy ctxt loc storage_type ginit
      >>=? fun (_, ctxt) ->
      typed
        ctxt
        loc
        (Create_contract_2 (storage_type, arg_type, lambda, root_name))
        (Item_t
           ( Operation_t None,
             Item_t (Address_t None, rest, addr_annot),
             op_annot ))
  | (Prim (loc, I_NOW, [], annot), stack) ->
      parse_var_annot loc annot ~default:default_now_annot
      >>=? fun annot ->
      typed ctxt loc Now (Item_t (Timestamp_t None, stack, annot))
  | (Prim (loc, I_AMOUNT, [], annot), stack) ->
      parse_var_annot loc annot ~default:default_amount_annot
      >>=? fun annot ->
      typed ctxt loc Amount (Item_t (Mutez_t None, stack, annot))
  | (Prim (loc, I_CHAIN_ID, [], annot), stack) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      typed ctxt loc ChainId (Item_t (Chain_id_t None, stack, annot))
  | (Prim (loc, I_BALANCE, [], annot), stack) ->
      parse_var_annot loc annot ~default:default_balance_annot
      >>=? fun annot ->
      typed ctxt loc Balance (Item_t (Mutez_t None, stack, annot))
  | (Prim (loc, I_HASH_KEY, [], annot), Item_t (Key_t _, rest, _)) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      typed ctxt loc Hash_key (Item_t (Key_hash_t None, rest, annot))
  | ( Prim (loc, I_CHECK_SIGNATURE, [], annot),
      Item_t
        (Key_t _, Item_t (Signature_t _, Item_t (Bytes_t _, rest, _), _), _) )
    ->
      parse_var_annot loc annot
      >>=? fun annot ->
      typed ctxt loc Check_signature (Item_t (Bool_t None, rest, annot))
  | (Prim (loc, I_BLAKE2B, [], annot), Item_t (Bytes_t _, rest, _)) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      typed ctxt loc Blake2b (Item_t (Bytes_t None, rest, annot))
  | (Prim (loc, I_SHA256, [], annot), Item_t (Bytes_t _, rest, _)) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      typed ctxt loc Sha256 (Item_t (Bytes_t None, rest, annot))
  | (Prim (loc, I_SHA512, [], annot), Item_t (Bytes_t _, rest, _)) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      typed ctxt loc Sha512 (Item_t (Bytes_t None, rest, annot))
  | (Prim (loc, I_STEPS_TO_QUOTA, [], annot), stack) ->
      if legacy then
        (* For existing contracts, this instruction is still allowed *)
        parse_var_annot loc annot ~default:default_steps_annot
        >>=? fun annot ->
        typed ctxt loc Steps_to_quota (Item_t (Nat_t None, stack, annot))
      else
        (* For new contracts this instruction is not allowed anymore *)
        fail (Deprecated_instruction I_STEPS_TO_QUOTA)
  | (Prim (loc, I_SOURCE, [], annot), stack) ->
      parse_var_annot loc annot ~default:default_source_annot
      >>=? fun annot ->
      typed ctxt loc Source (Item_t (Address_t None, stack, annot))
  | (Prim (loc, I_SENDER, [], annot), stack) ->
      parse_var_annot loc annot ~default:default_sender_annot
      >>=? fun annot ->
      typed ctxt loc Sender (Item_t (Address_t None, stack, annot))
  | (Prim (loc, I_SELF, [], annot), stack) ->
      parse_entrypoint_annot loc annot ~default:default_self_annot
      >>=? fun (annot, entrypoint) ->
      let entrypoint =
        Option.unopt_map
          ~f:(fun (`Field_annot annot) -> annot)
          ~default:"default"
          entrypoint
      in
      let rec get_toplevel_type :
          tc_context -> (bef judgement * context) tzresult Lwt.t = function
        | Lambda ->
            fail (Self_in_lambda loc)
        | Dip (_, prev) ->
            get_toplevel_type prev
        | Toplevel
            {param_type; root_name; legacy_create_contract_literal = false} ->
            Lwt.return (find_entrypoint param_type ~root_name entrypoint)
            >>=? fun (_, Ex_ty param_type) ->
            typed
              ctxt
              loc
              (Self (param_type, entrypoint))
              (Item_t (Contract_t (param_type, None), stack, annot))
        | Toplevel
            {param_type; root_name = _; legacy_create_contract_literal = true}
          ->
            typed
              ctxt
              loc
              (Self (param_type, "default"))
              (Item_t (Contract_t (param_type, None), stack, annot))
      in
      get_toplevel_type tc_context
  (* Primitive parsing errors *)
  | ( Prim
        ( loc,
          ( ( I_DUP
            | I_SWAP
            | I_SOME
            | I_UNIT
            | I_PAIR
            | I_CAR
            | I_CDR
            | I_CONS
            | I_CONCAT
            | I_SLICE
            | I_MEM
            | I_UPDATE
            | I_MAP
            | I_GET
            | I_EXEC
            | I_FAILWITH
            | I_SIZE
            | I_ADD
            | I_SUB
            | I_MUL
            | I_EDIV
            | I_OR
            | I_AND
            | I_XOR
            | I_NOT
            | I_ABS
            | I_NEG
            | I_LSL
            | I_LSR
            | I_COMPARE
            | I_EQ
            | I_NEQ
            | I_LT
            | I_GT
            | I_LE
            | I_GE
            | I_TRANSFER_TOKENS
            | I_CREATE_ACCOUNT
            | I_SET_DELEGATE
            | I_NOW
            | I_IMPLICIT_ACCOUNT
            | I_AMOUNT
            | I_BALANCE
            | I_CHECK_SIGNATURE
            | I_HASH_KEY
            | I_SOURCE
            | I_SENDER
            | I_BLAKE2B
            | I_SHA256
            | I_SHA512
            | I_STEPS_TO_QUOTA
            | I_ADDRESS ) as name ),
          (_ :: _ as l),
          _ ),
      _ ) ->
      fail (Invalid_arity (loc, name, 0, List.length l))
  | ( Prim
        ( loc,
          ( ( I_NONE
            | I_LEFT
            | I_RIGHT
            | I_NIL
            | I_MAP
            | I_ITER
            | I_EMPTY_SET
            | I_DIP
            | I_LOOP
            | I_LOOP_LEFT
            | I_CONTRACT ) as name ),
          (([] | _ :: _ :: _) as l),
          _ ),
      _ ) ->
      fail (Invalid_arity (loc, name, 1, List.length l))
  | ( Prim
        ( loc,
          ( (I_PUSH | I_IF_NONE | I_IF_LEFT | I_IF_CONS | I_EMPTY_MAP | I_IF)
          as name ),
          (([] | [_] | _ :: _ :: _ :: _) as l),
          _ ),
      _ ) ->
      fail (Invalid_arity (loc, name, 2, List.length l))
  | (Prim (loc, I_LAMBDA, (([] | [_] | _ :: _ :: _ :: _ :: _) as l), _), _) ->
      fail (Invalid_arity (loc, I_LAMBDA, 3, List.length l))
  (* Stack errors *)
  | ( Prim
        ( loc,
          ( ( I_ADD
            | I_SUB
            | I_MUL
            | I_EDIV
            | I_AND
            | I_OR
            | I_XOR
            | I_LSL
            | I_LSR ) as name ),
          [],
          _ ),
      Item_t (ta, Item_t (tb, _, _), _) ) ->
      Lwt.return @@ serialize_ty_for_error ctxt ta
      >>=? fun (ta, ctxt) ->
      Lwt.return @@ serialize_ty_for_error ctxt tb
      >>=? fun (tb, _ctxt) -> fail (Undefined_binop (loc, name, ta, tb))
  | ( Prim
        ( loc,
          ( ( I_NEG
            | I_ABS
            | I_NOT
            | I_CONCAT
            | I_SIZE
            | I_EQ
            | I_NEQ
            | I_LT
            | I_GT
            | I_LE
            | I_GE ) as name ),
          [],
          _ ),
      Item_t (t, _, _) ) ->
      Lwt.return @@ serialize_ty_for_error ctxt t
      >>=? fun (t, _ctxt) -> fail (Undefined_unop (loc, name, t))
  | (Prim (loc, ((I_UPDATE | I_SLICE) as name), [], _), stack) ->
      serialize_stack_for_error ctxt stack
      >>=? fun (stack, _ctxt) -> fail (Bad_stack (loc, name, 3, stack))
  | (Prim (loc, I_CREATE_CONTRACT, _, _), stack) ->
      serialize_stack_for_error ctxt stack
      >>=? fun (stack, _ctxt) ->
      fail (Bad_stack (loc, I_CREATE_CONTRACT, 7, stack))
  | (Prim (loc, I_CREATE_ACCOUNT, [], _), stack) ->
      serialize_stack_for_error ctxt stack
      >>=? fun (stack, _ctxt) ->
      fail (Bad_stack (loc, I_CREATE_ACCOUNT, 4, stack))
  | (Prim (loc, I_TRANSFER_TOKENS, [], _), stack) ->
      serialize_stack_for_error ctxt stack
      >>=? fun (stack, _ctxt) ->
      fail (Bad_stack (loc, I_TRANSFER_TOKENS, 4, stack))
  | ( Prim
        ( loc,
          ( ( I_DROP
            | I_DUP
            | I_CAR
            | I_CDR
            | I_SOME
            | I_BLAKE2B
            | I_SHA256
            | I_SHA512
            | I_DIP
            | I_IF_NONE
            | I_LEFT
            | I_RIGHT
            | I_IF_LEFT
            | I_IF
            | I_LOOP
            | I_IF_CONS
            | I_IMPLICIT_ACCOUNT
            | I_NEG
            | I_ABS
            | I_INT
            | I_NOT
            | I_HASH_KEY
            | I_EQ
            | I_NEQ
            | I_LT
            | I_GT
            | I_LE
            | I_GE ) as name ),
          _,
          _ ),
      stack ) ->
      serialize_stack_for_error ctxt stack
      >>=? fun (stack, _ctxt) -> fail (Bad_stack (loc, name, 1, stack))
  | ( Prim
        ( loc,
          ( ( I_SWAP
            | I_PAIR
            | I_CONS
            | I_GET
            | I_MEM
            | I_EXEC
            | I_CHECK_SIGNATURE
            | I_ADD
            | I_SUB
            | I_MUL
            | I_EDIV
            | I_AND
            | I_OR
            | I_XOR
            | I_LSL
            | I_LSR ) as name ),
          _,
          _ ),
      stack ) ->
      serialize_stack_for_error ctxt stack
      >>=? fun (stack, _ctxt) -> fail (Bad_stack (loc, name, 2, stack))
  (* Generic parsing errors *)
  | (expr, _) ->
      fail
      @@ unexpected
           expr
           [Seq_kind]
           Instr_namespace
           [ I_DROP;
             I_DUP;
             I_DIG;
             I_DUG;
             I_SWAP;
             I_SOME;
             I_UNIT;
             I_PAIR;
             I_CAR;
             I_CDR;
             I_CONS;
             I_MEM;
             I_UPDATE;
             I_MAP;
             I_ITER;
             I_GET;
             I_EXEC;
             I_FAILWITH;
             I_SIZE;
             I_CONCAT;
             I_ADD;
             I_SUB;
             I_MUL;
             I_EDIV;
             I_OR;
             I_AND;
             I_XOR;
             I_NOT;
             I_ABS;
             I_INT;
             I_NEG;
             I_LSL;
             I_LSR;
             I_COMPARE;
             I_EQ;
             I_NEQ;
             I_LT;
             I_GT;
             I_LE;
             I_GE;
             I_TRANSFER_TOKENS;
             I_CREATE_ACCOUNT;
             I_CREATE_CONTRACT;
             I_NOW;
             I_AMOUNT;
             I_BALANCE;
             I_IMPLICIT_ACCOUNT;
             I_CHECK_SIGNATURE;
             I_BLAKE2B;
             I_SHA256;
             I_SHA512;
             I_HASH_KEY;
             I_STEPS_TO_QUOTA;
             I_PUSH;
             I_NONE;
             I_LEFT;
             I_RIGHT;
             I_NIL;
             I_EMPTY_SET;
             I_DIP;
             I_LOOP;
             I_IF_NONE;
             I_IF_LEFT;
             I_IF_CONS;
             I_EMPTY_MAP;
             I_IF;
             I_SOURCE;
             I_SENDER;
             I_SELF;
             I_LAMBDA ]

and parse_contract :
    type arg.
    legacy:bool ->
    context ->
    Script.location ->
    arg ty ->
    Contract.t ->
    entrypoint:string ->
    (context * arg typed_contract) tzresult Lwt.t =
 fun ~legacy ctxt loc arg contract ~entrypoint ->
  Lwt.return @@ Gas.consume ctxt Typecheck_costs.contract_exists
  >>=? fun ctxt ->
  Contract.exists ctxt contract
  >>=? function
  | false ->
      fail (Invalid_contract (loc, contract))
  | true -> (
      Lwt.return @@ Gas.consume ctxt Typecheck_costs.get_script
      >>=? fun ctxt ->
      trace (Invalid_contract (loc, contract))
      @@ Contract.get_script_code ctxt contract
      >>=? fun (ctxt, code) ->
      match code with
      | None ->
          Lwt.return
            ( ty_eq ctxt arg (Unit_t None)
            >>? fun (Eq, ctxt) ->
            match entrypoint with
            | "default" ->
                let contract : arg typed_contract =
                  (arg, (contract, entrypoint))
                in
                ok (ctxt, contract)
            | entrypoint ->
                error (No_such_entrypoint entrypoint) )
      | Some code ->
          Script.force_decode ctxt code
          >>=? fun (code, ctxt) ->
          Lwt.return
            ( parse_toplevel ~legacy:true code
            >>? fun (arg_type, _, _, root_name) ->
            parse_parameter_ty ctxt ~legacy:true arg_type
            >>? fun (Ex_ty targ, ctxt) ->
            let return ctxt targ entrypoint =
              merge_types ~legacy ctxt loc targ arg
              >>? fun (arg, ctxt) ->
              let contract : arg typed_contract =
                (arg, (contract, entrypoint))
              in
              ok (ctxt, contract)
            in
            find_entrypoint_for_type
              ~full:targ
              ~expected:arg
              ~root_name
              entrypoint
              ctxt
            >>? fun (ctxt, entrypoint, targ) ->
            merge_types ~legacy ctxt loc targ arg
            >>? fun (targ, ctxt) -> return ctxt targ entrypoint ) )

(* Same as the one above, but does not fail when the contact is missing or
   if the expected type doesn't match the actual one. In that case None is
   returned and some overapproximation of the typechecking gas is consumed.
   This can still fail on gas exhaustion. *)
and parse_contract_for_script :
    type arg.
    legacy:bool ->
    context ->
    Script.location ->
    arg ty ->
    Contract.t ->
    entrypoint:string ->
    (context * arg typed_contract option) tzresult Lwt.t =
 fun ~legacy ctxt loc arg contract ~entrypoint ->
  Lwt.return @@ Gas.consume ctxt Typecheck_costs.contract_exists
  >>=? fun ctxt ->
  Contract.exists ctxt contract
  >>=? function
  | false ->
      return (ctxt, None)
  | true -> (
      Lwt.return @@ Gas.consume ctxt Typecheck_costs.get_script
      >>=? fun ctxt ->
      trace (Invalid_contract (loc, contract))
      @@ Contract.get_script_code ctxt contract
      >>=? fun (ctxt, code) ->
      match code with
      (* can only fail because of gas *)
      | None -> (
        match entrypoint with
        | "default" ->
            Lwt.return
              ( match ty_eq ctxt arg (Unit_t None) with
              | Ok (Eq, ctxt) ->
                  let contract : arg typed_contract =
                    (arg, (contract, entrypoint))
                  in
                  ok (ctxt, Some contract)
              | Error _ ->
                  Gas.consume ctxt Typecheck_costs.cycle
                  >>? fun ctxt -> ok (ctxt, None) )
        | _ ->
            return (ctxt, None) )
      | Some code ->
          Script.force_decode ctxt code
          >>=? fun (code, ctxt) ->
          (* can only fail because of gas *)
          Lwt.return
            ( match parse_toplevel ~legacy:true code with
            | Error _ ->
                error (Invalid_contract (loc, contract))
            | Ok (arg_type, _, _, root_name) -> (
              match parse_parameter_ty ctxt ~legacy:true arg_type with
              | Error _ ->
                  error (Invalid_contract (loc, contract))
              | Ok (Ex_ty targ, ctxt) -> (
                match
                  find_entrypoint_for_type
                    ~full:targ
                    ~expected:arg
                    ~root_name
                    entrypoint
                    ctxt
                  >>? fun (ctxt, entrypoint, targ) ->
                  merge_types ~legacy ctxt loc targ arg
                  >>? fun (targ, ctxt) ->
                  merge_types ~legacy ctxt loc targ arg
                  >>? fun (arg, ctxt) ->
                  let contract : arg typed_contract =
                    (arg, (contract, entrypoint))
                  in
                  ok (ctxt, Some contract)
                with
                | Ok res ->
                    ok res
                | Error _ ->
                    (* overapproximation by checking if targ = targ,
                                                       can only fail because of gas *)
                    ty_eq ctxt targ targ
                    >>? fun (Eq, ctxt) ->
                    merge_types ~legacy ctxt loc targ targ
                    >>? fun (_, ctxt) -> ok (ctxt, None) ) ) ) )

and parse_toplevel :
    legacy:bool ->
    Script.expr ->
    (Script.node * Script.node * Script.node * string option) tzresult =
 fun ~legacy toplevel ->
  record_trace (Ill_typed_contract (toplevel, []))
  @@
  match root toplevel with
  | Int (loc, _) ->
      error (Invalid_kind (loc, [Seq_kind], Int_kind))
  | String (loc, _) ->
      error (Invalid_kind (loc, [Seq_kind], String_kind))
  | Bytes (loc, _) ->
      error (Invalid_kind (loc, [Seq_kind], Bytes_kind))
  | Prim (loc, _, _, _) ->
      error (Invalid_kind (loc, [Seq_kind], Prim_kind))
  | Seq (_, fields) -> (
      let rec find_fields p s c fields =
        match fields with
        | [] ->
            ok (p, s, c)
        | Int (loc, _) :: _ ->
            error (Invalid_kind (loc, [Prim_kind], Int_kind))
        | String (loc, _) :: _ ->
            error (Invalid_kind (loc, [Prim_kind], String_kind))
        | Bytes (loc, _) :: _ ->
            error (Invalid_kind (loc, [Prim_kind], Bytes_kind))
        | Seq (loc, _) :: _ ->
            error (Invalid_kind (loc, [Prim_kind], Seq_kind))
        | Prim (loc, K_parameter, [arg], annot) :: rest -> (
          match p with
          | None ->
              find_fields (Some (arg, loc, annot)) s c rest
          | Some _ ->
              error (Duplicate_field (loc, K_parameter)) )
        | Prim (loc, K_storage, [arg], annot) :: rest -> (
          match s with
          | None ->
              find_fields p (Some (arg, loc, annot)) c rest
          | Some _ ->
              error (Duplicate_field (loc, K_storage)) )
        | Prim (loc, K_code, [arg], annot) :: rest -> (
          match c with
          | None ->
              find_fields p s (Some (arg, loc, annot)) rest
          | Some _ ->
              error (Duplicate_field (loc, K_code)) )
        | Prim (loc, ((K_parameter | K_storage | K_code) as name), args, _)
          :: _ ->
            error (Invalid_arity (loc, name, 1, List.length args))
        | Prim (loc, name, _, _) :: _ ->
            let allowed = [K_parameter; K_storage; K_code] in
            error (Invalid_primitive (loc, allowed, name))
      in
      find_fields None None None fields
      >>? function
      | (None, _, _) ->
          error (Missing_field K_parameter)
      | (Some _, None, _) ->
          error (Missing_field K_storage)
      | (Some _, Some _, None) ->
          error (Missing_field K_code)
      | (Some (p, ploc, pannot), Some (s, sloc, sannot), Some (c, cloc, carrot))
        ->
          let maybe_root_name =
            (* root name can be attached to either the parameter
                 primitive or the toplevel constructor *)
            Script_ir_annot.extract_field_annot p
            >>? fun (p, root_name) ->
            match root_name with
            | Some (`Field_annot root_name) ->
                ok (p, pannot, Some root_name)
            | None -> (
              match pannot with
              | [single]
                when Compare.Int.(String.length single > 0)
                     && Compare.Char.(single.[0] = '%') ->
                  ok
                    ( p,
                      [],
                      Some (String.sub single 1 (String.length single - 1)) )
              | _ ->
                  ok (p, pannot, None) )
          in
          if legacy then
            (* legacy semantics ignores spurious annotations *)
            let (p, root_name) =
              match maybe_root_name with
              | Ok (p, _, root_name) ->
                  (p, root_name)
              | Error _ ->
                  (p, None)
            in
            ok (p, s, c, root_name)
          else
            (* only one field annot is allowed to set the root entrypoint name *)
            maybe_root_name
            >>? fun (p, pannot, root_name) ->
            Script_ir_annot.error_unexpected_annot ploc pannot
            >>? fun () ->
            Script_ir_annot.error_unexpected_annot cloc carrot
            >>? fun () ->
            Script_ir_annot.error_unexpected_annot sloc sannot
            >>? fun () -> ok (p, s, c, root_name) )

let parse_script :
    ?type_logger:type_logger ->
    context ->
    legacy:bool ->
    Script.t ->
    (ex_script * context) tzresult Lwt.t =
 fun ?type_logger ctxt ~legacy {code; storage} ->
  Script.force_decode ctxt code
  >>=? fun (code, ctxt) ->
  Script.force_decode ctxt storage
  >>=? fun (storage, ctxt) ->
  Lwt.return @@ parse_toplevel ~legacy code
  >>=? fun (arg_type, storage_type, code_field, root_name) ->
  trace
    (Ill_formed_type (Some "parameter", code, location arg_type))
    (Lwt.return (parse_parameter_ty ctxt ~legacy arg_type))
  >>=? fun (Ex_ty arg_type, ctxt) ->
  ( if legacy then return ()
  else Lwt.return (well_formed_entrypoints ~root_name arg_type) )
  >>=? fun () ->
  trace
    (Ill_formed_type (Some "storage", code, location storage_type))
    (Lwt.return (parse_storage_ty ctxt ~legacy storage_type))
  >>=? fun (Ex_ty storage_type, ctxt) ->
  let arg_annot =
    default_annot
      (type_to_var_annot (name_of_ty arg_type))
      ~default:default_param_annot
  in
  let storage_annot =
    default_annot
      (type_to_var_annot (name_of_ty storage_type))
      ~default:default_storage_annot
  in
  let arg_type_full =
    Pair_t
      ( (arg_type, None, arg_annot),
        (storage_type, None, storage_annot),
        None,
        has_big_map arg_type || has_big_map storage_type )
  in
  let ret_type_full =
    Pair_t
      ( (List_t (Operation_t None, None, false), None, None),
        (storage_type, None, None),
        None,
        has_big_map storage_type )
  in
  trace_eval
    (fun () ->
      Lwt.return @@ serialize_ty_for_error ctxt storage_type
      >>|? fun (storage_type, _ctxt) ->
      Ill_typed_data (None, storage, storage_type))
    (parse_data ?type_logger ctxt ~legacy storage_type (root storage))
  >>=? fun (storage, ctxt) ->
  trace
    (Ill_typed_contract (code, []))
    (parse_returning
       (Toplevel
          {
            storage_type;
            param_type = arg_type;
            root_name;
            legacy_create_contract_literal = false;
          })
       ctxt
       ~legacy
       ?type_logger
       (arg_type_full, None)
       ret_type_full
       code_field)
  >>=? fun (code, ctxt) ->
  return (Ex_script {code; arg_type; storage; storage_type; root_name}, ctxt)

let typecheck_code :
    context -> Script.expr -> (type_map * context) tzresult Lwt.t =
 fun ctxt code ->
  let legacy = false in
  Lwt.return @@ parse_toplevel ~legacy code
  >>=? fun (arg_type, storage_type, code_field, root_name) ->
  let type_map = ref [] in
  trace
    (Ill_formed_type (Some "parameter", code, location arg_type))
    (Lwt.return (parse_parameter_ty ctxt ~legacy arg_type))
  >>=? fun (Ex_ty arg_type, ctxt) ->
  ( if legacy then return ()
  else Lwt.return (well_formed_entrypoints ~root_name arg_type) )
  >>=? fun () ->
  trace
    (Ill_formed_type (Some "storage", code, location storage_type))
    (Lwt.return (parse_storage_ty ctxt ~legacy storage_type))
  >>=? fun (Ex_ty storage_type, ctxt) ->
  let arg_annot =
    default_annot
      (type_to_var_annot (name_of_ty arg_type))
      ~default:default_param_annot
  in
  let storage_annot =
    default_annot
      (type_to_var_annot (name_of_ty storage_type))
      ~default:default_storage_annot
  in
  let arg_type_full =
    Pair_t
      ( (arg_type, None, arg_annot),
        (storage_type, None, storage_annot),
        None,
        has_big_map arg_type || has_big_map storage_type )
  in
  let ret_type_full =
    Pair_t
      ( (List_t (Operation_t None, None, false), None, None),
        (storage_type, None, None),
        None,
        has_big_map storage_type )
  in
  let result =
    parse_returning
      (Toplevel
         {
           storage_type;
           param_type = arg_type;
           root_name;
           legacy_create_contract_literal = false;
         })
      ctxt
      ~legacy
      ~type_logger:(fun loc bef aft ->
        type_map := (loc, (bef, aft)) :: !type_map)
      (arg_type_full, None)
      ret_type_full
      code_field
  in
  trace (Ill_typed_contract (code, !type_map)) result
  >>=? fun (Lam _, ctxt) -> return (!type_map, ctxt)

let typecheck_data :
    ?type_logger:type_logger ->
    context ->
    Script.expr * Script.expr ->
    context tzresult Lwt.t =
 fun ?type_logger ctxt (data, exp_ty) ->
  let legacy = false in
  trace
    (Ill_formed_type (None, exp_ty, 0))
    (Lwt.return @@ parse_packable_ty ctxt ~legacy (root exp_ty))
  >>=? fun (Ex_ty exp_ty, ctxt) ->
  trace_eval
    (fun () ->
      Lwt.return @@ serialize_ty_for_error ctxt exp_ty
      >>|? fun (exp_ty, _ctxt) -> Ill_typed_data (None, data, exp_ty))
    (parse_data ?type_logger ctxt ~legacy exp_ty (root data))
  >>=? fun (_, ctxt) -> return ctxt

module Entrypoints_map = Map.Make (String)

let list_entrypoints (type full) (full : full ty) ctxt ~root_name =
  let merge path annot (type t) (ty : t ty) reachable
      ((unreachables, all) as acc) =
    match annot with
    | None | Some (`Field_annot "") -> (
        ok
        @@
        if reachable then acc
        else
          match ty with
          | Union_t _ ->
              acc
          | _ ->
              (List.rev path :: unreachables, all) )
    | Some (`Field_annot name) ->
        if Compare.Int.(String.length name > 31) then
          ok (List.rev path :: unreachables, all)
        else if Entrypoints_map.mem name all then
          ok (List.rev path :: unreachables, all)
        else
          unparse_ty_no_lwt ctxt ty
          >>? fun (unparsed_ty, _) ->
          ok
            ( unreachables,
              Entrypoints_map.add name (List.rev path, unparsed_ty) all )
  in
  let rec fold_tree :
      type t.
      t ty ->
      prim list ->
      bool ->
      prim list list * (prim list * Script.node) Entrypoints_map.t ->
      (prim list list * (prim list * Script.node) Entrypoints_map.t) tzresult =
   fun t path reachable acc ->
    match t with
    | Union_t ((tl, al), (tr, ar), _, _) ->
        merge (D_Left :: path) al tl reachable acc
        >>? fun acc ->
        merge (D_Right :: path) ar tr reachable acc
        >>? fun acc ->
        fold_tree
          tl
          (D_Left :: path)
          (match al with Some _ -> true | None -> reachable)
          acc
        >>? fun acc ->
        fold_tree
          tr
          (D_Right :: path)
          (match ar with Some _ -> true | None -> reachable)
          acc
    | _ ->
        ok acc
  in
  unparse_ty_no_lwt ctxt full
  >>? fun (unparsed_full, _) ->
  let (init, reachable) =
    match root_name with
    | None | Some "" ->
        (Entrypoints_map.empty, false)
    | Some name ->
        (Entrypoints_map.singleton name ([], unparsed_full), true)
  in
  fold_tree full [] reachable ([], init)

(* ---- Unparsing (Typed IR -> Untyped expressions) --------------------------*)

let rec unparse_data :
    type a.
    context ->
    unparsing_mode ->
    a ty ->
    a ->
    (Script.node * context) tzresult Lwt.t =
 fun ctxt mode ty a ->
  Lwt.return (Gas.consume ctxt Unparse_costs.cycle)
  >>=? fun ctxt ->
  match (ty, a) with
  | (Unit_t _, ()) ->
      Lwt.return (Gas.consume ctxt Unparse_costs.unit)
      >>=? fun ctxt -> return (Prim (-1, D_Unit, [], []), ctxt)
  | (Int_t _, v) ->
      Lwt.return (Gas.consume ctxt (Unparse_costs.int v))
      >>=? fun ctxt -> return (Int (-1, Script_int.to_zint v), ctxt)
  | (Nat_t _, v) ->
      Lwt.return (Gas.consume ctxt (Unparse_costs.int v))
      >>=? fun ctxt -> return (Int (-1, Script_int.to_zint v), ctxt)
  | (String_t _, s) ->
      Lwt.return (Gas.consume ctxt (Unparse_costs.string s))
      >>=? fun ctxt -> return (String (-1, s), ctxt)
  | (Bytes_t _, s) ->
      Lwt.return (Gas.consume ctxt (Unparse_costs.bytes s))
      >>=? fun ctxt -> return (Bytes (-1, s), ctxt)
  | (Bool_t _, true) ->
      Lwt.return (Gas.consume ctxt Unparse_costs.bool)
      >>=? fun ctxt -> return (Prim (-1, D_True, [], []), ctxt)
  | (Bool_t _, false) ->
      Lwt.return (Gas.consume ctxt Unparse_costs.bool)
      >>=? fun ctxt -> return (Prim (-1, D_False, [], []), ctxt)
  | (Timestamp_t _, t) -> (
      Lwt.return (Gas.consume ctxt (Unparse_costs.timestamp t))
      >>=? fun ctxt ->
      match mode with
      | Optimized ->
          return (Int (-1, Script_timestamp.to_zint t), ctxt)
      | Readable -> (
        match Script_timestamp.to_notation t with
        | None ->
            return (Int (-1, Script_timestamp.to_zint t), ctxt)
        | Some s ->
            return (String (-1, s), ctxt) ) )
  | (Address_t _, (c, entrypoint)) -> (
      Lwt.return (Gas.consume ctxt Unparse_costs.contract)
      >>=? fun ctxt ->
      match mode with
      | Optimized ->
          let entrypoint =
            match entrypoint with "default" -> "" | name -> name
          in
          let bytes =
            Data_encoding.Binary.to_bytes_exn
              Data_encoding.(tup2 Contract.encoding Variable.string)
              (c, entrypoint)
          in
          return (Bytes (-1, bytes), ctxt)
      | Readable ->
          let notation =
            match entrypoint with
            | "default" ->
                Contract.to_b58check c
            | entrypoint ->
                Contract.to_b58check c ^ "%" ^ entrypoint
          in
          return (String (-1, notation), ctxt) )
  | (Contract_t _, (_, (c, entrypoint))) -> (
      Lwt.return (Gas.consume ctxt Unparse_costs.contract)
      >>=? fun ctxt ->
      match mode with
      | Optimized ->
          let entrypoint =
            match entrypoint with "default" -> "" | name -> name
          in
          let bytes =
            Data_encoding.Binary.to_bytes_exn
              Data_encoding.(tup2 Contract.encoding Variable.string)
              (c, entrypoint)
          in
          return (Bytes (-1, bytes), ctxt)
      | Readable ->
          let notation =
            match entrypoint with
            | "default" ->
                Contract.to_b58check c
            | entrypoint ->
                Contract.to_b58check c ^ "%" ^ entrypoint
          in
          return (String (-1, notation), ctxt) )
  | (Signature_t _, s) -> (
      Lwt.return (Gas.consume ctxt Unparse_costs.signature)
      >>=? fun ctxt ->
      match mode with
      | Optimized ->
          let bytes = Data_encoding.Binary.to_bytes_exn Signature.encoding s in
          return (Bytes (-1, bytes), ctxt)
      | Readable ->
          return (String (-1, Signature.to_b58check s), ctxt) )
  | (Mutez_t _, v) ->
      Lwt.return (Gas.consume ctxt Unparse_costs.tez)
      >>=? fun ctxt -> return (Int (-1, Z.of_int64 (Tez.to_mutez v)), ctxt)
  | (Key_t _, k) -> (
      Lwt.return (Gas.consume ctxt Unparse_costs.key)
      >>=? fun ctxt ->
      match mode with
      | Optimized ->
          let bytes =
            Data_encoding.Binary.to_bytes_exn Signature.Public_key.encoding k
          in
          return (Bytes (-1, bytes), ctxt)
      | Readable ->
          return (String (-1, Signature.Public_key.to_b58check k), ctxt) )
  | (Key_hash_t _, k) -> (
      Lwt.return (Gas.consume ctxt Unparse_costs.key_hash)
      >>=? fun ctxt ->
      match mode with
      | Optimized ->
          let bytes =
            Data_encoding.Binary.to_bytes_exn
              Signature.Public_key_hash.encoding
              k
          in
          return (Bytes (-1, bytes), ctxt)
      | Readable ->
          return (String (-1, Signature.Public_key_hash.to_b58check k), ctxt) )
  | (Operation_t _, (op, _big_map_diff)) ->
      let bytes =
        Data_encoding.Binary.to_bytes_exn
          Operation.internal_operation_encoding
          op
      in
      Lwt.return (Gas.consume ctxt (Unparse_costs.operation bytes))
      >>=? fun ctxt -> return (Bytes (-1, bytes), ctxt)
  | (Chain_id_t _, chain_id) ->
      let bytes =
        Data_encoding.Binary.to_bytes_exn Chain_id.encoding chain_id
      in
      Lwt.return (Gas.consume ctxt (Unparse_costs.chain_id bytes))
      >>=? fun ctxt -> return (Bytes (-1, bytes), ctxt)
  | (Pair_t ((tl, _, _), (tr, _, _), _, _), (l, r)) ->
      Lwt.return (Gas.consume ctxt Unparse_costs.pair)
      >>=? fun ctxt ->
      unparse_data ctxt mode tl l
      >>=? fun (l, ctxt) ->
      unparse_data ctxt mode tr r
      >>=? fun (r, ctxt) -> return (Prim (-1, D_Pair, [l; r], []), ctxt)
  | (Union_t ((tl, _), _, _, _), L l) ->
      Lwt.return (Gas.consume ctxt Unparse_costs.union)
      >>=? fun ctxt ->
      unparse_data ctxt mode tl l
      >>=? fun (l, ctxt) -> return (Prim (-1, D_Left, [l], []), ctxt)
  | (Union_t (_, (tr, _), _, _), R r) ->
      Lwt.return (Gas.consume ctxt Unparse_costs.union)
      >>=? fun ctxt ->
      unparse_data ctxt mode tr r
      >>=? fun (r, ctxt) -> return (Prim (-1, D_Right, [r], []), ctxt)
  | (Option_t (t, _, _), Some v) ->
      Lwt.return (Gas.consume ctxt Unparse_costs.some)
      >>=? fun ctxt ->
      unparse_data ctxt mode t v
      >>=? fun (v, ctxt) -> return (Prim (-1, D_Some, [v], []), ctxt)
  | (Option_t _, None) ->
      Lwt.return (Gas.consume ctxt Unparse_costs.none)
      >>=? fun ctxt -> return (Prim (-1, D_None, [], []), ctxt)
  | (List_t (t, _, _), items) ->
      fold_left_s
        (fun (l, ctxt) element ->
          Lwt.return (Gas.consume ctxt Unparse_costs.list_element)
          >>=? fun ctxt ->
          unparse_data ctxt mode t element
          >>=? fun (unparsed, ctxt) -> return (unparsed :: l, ctxt))
        ([], ctxt)
        items
      >>=? fun (items, ctxt) ->
      return (Micheline.Seq (-1, List.rev items), ctxt)
  | (Set_t (t, _), set) ->
      let t = ty_of_comparable_ty t in
      fold_left_s
        (fun (l, ctxt) item ->
          Lwt.return (Gas.consume ctxt Unparse_costs.set_element)
          >>=? fun ctxt ->
          unparse_data ctxt mode t item
          >>=? fun (item, ctxt) -> return (item :: l, ctxt))
        ([], ctxt)
        (set_fold (fun e acc -> e :: acc) set [])
      >>=? fun (items, ctxt) -> return (Micheline.Seq (-1, items), ctxt)
  | (Map_t (kt, vt, _, _), map) ->
      let kt = ty_of_comparable_ty kt in
      fold_left_s
        (fun (l, ctxt) (k, v) ->
          Lwt.return (Gas.consume ctxt Unparse_costs.map_element)
          >>=? fun ctxt ->
          unparse_data ctxt mode kt k
          >>=? fun (key, ctxt) ->
          unparse_data ctxt mode vt v
          >>=? fun (value, ctxt) ->
          return (Prim (-1, D_Elt, [key; value], []) :: l, ctxt))
        ([], ctxt)
        (map_fold (fun k v acc -> (k, v) :: acc) map [])
      >>=? fun (items, ctxt) -> return (Micheline.Seq (-1, items), ctxt)
  | (Big_map_t (kt, vt, _), {id = None; diff = (module Diff); _}) ->
      (* this branch is to allow roundtrip of big map literals *)
      let kt = ty_of_comparable_ty kt in
      fold_left_s
        (fun (l, ctxt) (k, v) ->
          Lwt.return (Gas.consume ctxt Unparse_costs.map_element)
          >>=? fun ctxt ->
          unparse_data ctxt mode kt k
          >>=? fun (key, ctxt) ->
          unparse_data ctxt mode vt v
          >>=? fun (value, ctxt) ->
          return (Prim (-1, D_Elt, [key; value], []) :: l, ctxt))
        ([], ctxt)
        (Diff.OPS.fold
           (fun k v acc ->
             match v with None -> acc | Some v -> (k, v) :: acc)
           (fst Diff.boxed)
           [])
      >>=? fun (items, ctxt) -> return (Micheline.Seq (-1, items), ctxt)
  | (Big_map_t (_kt, _kv, _), {id = Some id; diff = (module Diff); _}) ->
      if Compare.Int.(Diff.OPS.cardinal (fst Diff.boxed) = 0) then
        return (Micheline.Int (-1, id), ctxt)
      else
        (* this can only be the result of an execution and the map
             must have been flushed at this point *)
        assert false
  | (Lambda_t _, Lam (_, original_code)) ->
      unparse_code ctxt mode original_code

(* Gas accounting may not be perfect in this function, as it is only called by RPCs. *)
and unparse_code ctxt mode =
  let legacy = true in
  function
  | Prim (loc, I_PUSH, [ty; data], annot) ->
      Lwt.return (parse_packable_ty ctxt ~legacy ty)
      >>=? fun (Ex_ty t, ctxt) ->
      parse_data ctxt ~legacy t data
      >>=? fun (data, ctxt) ->
      unparse_data ctxt mode t data
      >>=? fun (data, ctxt) ->
      Lwt.return (Gas.consume ctxt (Unparse_costs.prim_cost 2 annot))
      >>=? fun ctxt -> return (Prim (loc, I_PUSH, [ty; data], annot), ctxt)
  | Seq (loc, items) ->
      fold_left_s
        (fun (l, ctxt) item ->
          unparse_code ctxt mode item
          >>=? fun (item, ctxt) -> return (item :: l, ctxt))
        ([], ctxt)
        items
      >>=? fun (items, ctxt) ->
      Lwt.return
        (Gas.consume ctxt (Unparse_costs.seq_cost (List.length items)))
      >>=? fun ctxt -> return (Micheline.Seq (loc, List.rev items), ctxt)
  | Prim (loc, prim, items, annot) ->
      fold_left_s
        (fun (l, ctxt) item ->
          unparse_code ctxt mode item
          >>=? fun (item, ctxt) -> return (item :: l, ctxt))
        ([], ctxt)
        items
      >>=? fun (items, ctxt) ->
      Lwt.return (Gas.consume ctxt (Unparse_costs.prim_cost 3 annot))
      >>=? fun ctxt -> return (Prim (loc, prim, List.rev items, annot), ctxt)
  | (Int _ | String _ | Bytes _) as atom ->
      return (atom, ctxt)

(* Gas accounting may not be perfect in this function, as it is only called by RPCs. *)
let unparse_script ctxt mode {code; arg_type; storage; storage_type; root_name}
    =
  let (Lam (_, original_code)) = code in
  unparse_code ctxt mode original_code
  >>=? fun (code, ctxt) ->
  unparse_data ctxt mode storage_type storage
  >>=? fun (storage, ctxt) ->
  unparse_ty ctxt arg_type
  >>=? fun (arg_type, ctxt) ->
  unparse_ty ctxt storage_type
  >>=? fun (storage_type, ctxt) ->
  let arg_type =
    add_field_annot
      (Option.map ~f:(fun n -> `Field_annot n) root_name)
      None
      arg_type
  in
  let open Micheline in
  let code =
    Seq
      ( -1,
        [ Prim (-1, K_parameter, [arg_type], []);
          Prim (-1, K_storage, [storage_type], []);
          Prim (-1, K_code, [code], []) ] )
  in
  Lwt.return
    ( Gas.consume ctxt (Unparse_costs.seq_cost 3)
    >>? fun ctxt ->
    Gas.consume ctxt (Unparse_costs.prim_cost 1 [])
    >>? fun ctxt ->
    Gas.consume ctxt (Unparse_costs.prim_cost 1 [])
    >>? fun ctxt -> Gas.consume ctxt (Unparse_costs.prim_cost 1 []) )
  >>=? fun ctxt ->
  return
    ( {
        code = lazy_expr (strip_locations code);
        storage = lazy_expr (strip_locations storage);
      },
      ctxt )

let pack_data ctxt typ data =
  unparse_data ctxt Optimized typ data
  >>=? fun (unparsed, ctxt) ->
  let bytes =
    Data_encoding.Binary.to_bytes_exn
      expr_encoding
      (Micheline.strip_locations unparsed)
  in
  Lwt.return @@ Gas.consume ctxt (Script.serialized_cost bytes)
  >>=? fun ctxt ->
  let bytes = MBytes.concat "" [MBytes.of_string "\005"; bytes] in
  Lwt.return @@ Gas.consume ctxt (Script.serialized_cost bytes)
  >>=? fun ctxt -> return (bytes, ctxt)

let hash_data ctxt typ data =
  pack_data ctxt typ data
  >>=? fun (bytes, ctxt) ->
  Lwt.return
  @@ Gas.consume
       ctxt
       (Michelson_v1_gas.Cost_of.Legacy.hash bytes Script_expr_hash.size)
  >>=? fun ctxt -> return (Script_expr_hash.(hash_bytes [bytes]), ctxt)

(* ---------------- Big map -------------------------------------------------*)

let empty_big_map tk tv =
  {
    id = None;
    diff = empty_map tk;
    key_type = ty_of_comparable_ty tk;
    value_type = tv;
  }

let big_map_mem ctxt key {id; diff; key_type; _} =
  match (map_get key diff, id) with
  | (None, None) ->
      return (false, ctxt)
  | (None, Some id) ->
      hash_data ctxt key_type key
      >>=? fun (hash, ctxt) ->
      Alpha_context.Big_map.mem ctxt id hash
      >>=? fun (ctxt, res) -> return (res, ctxt)
  | (Some None, _) ->
      return (false, ctxt)
  | (Some (Some _), _) ->
      return (true, ctxt)

let big_map_get ctxt key {id; diff; key_type; value_type} =
  match (map_get key diff, id) with
  | (Some x, _) ->
      return (x, ctxt)
  | (None, None) ->
      return (None, ctxt)
  | (None, Some id) -> (
      hash_data ctxt key_type key
      >>=? fun (hash, ctxt) ->
      Alpha_context.Big_map.get_opt ctxt id hash
      >>=? function
      | (ctxt, None) ->
          return (None, ctxt)
      | (ctxt, Some value) ->
          parse_data ctxt ~legacy:true value_type (Micheline.root value)
          >>=? fun (x, ctxt) -> return (Some x, ctxt) )

let big_map_update key value ({diff; _} as map) =
  {map with diff = map_set key value diff}

module Ids = Set.Make (Compare.Z)

type big_map_ids = Ids.t

let no_big_map_id = Ids.empty

let diff_of_big_map ctxt fresh mode ~ids {id; key_type; value_type; diff} =
  Lwt.return
    (Gas.consume ctxt (Michelson_v1_gas.Cost_of.Legacy.map_to_list diff))
  >>=? fun ctxt ->
  ( match id with
  | Some id ->
      if Ids.mem id ids then
        fresh ctxt
        >>=? fun (ctxt, duplicate) ->
        return (ctxt, [Contract.Copy (id, duplicate)], duplicate)
      else
        (* The first occurence encountered of a big_map reuses the
             ID. This way, the payer is only charged for the diff.
             For this to work, this diff has to be put at the end of
             the global diff, otherwise the duplicates will use the
             updated version as a base. This is true because we add
             this diff first in the accumulator of
             `extract_big_map_updates`, and this accumulator is not
             reversed before being flattened. *)
        return (ctxt, [], id)
  | None ->
      fresh ctxt
      >>=? fun (ctxt, id) ->
      unparse_ty ctxt key_type
      >>=? fun (kt, ctxt) ->
      unparse_ty ctxt value_type
      >>=? fun (kv, ctxt) ->
      return
        ( ctxt,
          [ Contract.Alloc
              {
                big_map = id;
                key_type = Micheline.strip_locations kt;
                value_type = Micheline.strip_locations kv;
              } ],
          id ) )
  >>=? fun (ctxt, init, big_map) ->
  let pairs = map_fold (fun key value acc -> (key, value) :: acc) diff [] in
  fold_left_s
    (fun (acc, ctxt) (key, value) ->
      Lwt.return (Gas.consume ctxt Typecheck_costs.cycle)
      >>=? fun ctxt ->
      hash_data ctxt key_type key
      >>=? fun (diff_key_hash, ctxt) ->
      unparse_data ctxt mode key_type key
      >>=? fun (key_node, ctxt) ->
      let diff_key = Micheline.strip_locations key_node in
      ( match value with
      | None ->
          return (None, ctxt)
      | Some x ->
          unparse_data ctxt mode value_type x
          >>=? fun (node, ctxt) ->
          return (Some (Micheline.strip_locations node), ctxt) )
      >>=? fun (diff_value, ctxt) ->
      let diff_item =
        Contract.Update {big_map; diff_key; diff_key_hash; diff_value}
      in
      return (diff_item :: acc, ctxt))
    ([], ctxt)
    pairs
  >>=? fun (diff, ctxt) -> return (init @ diff, big_map, ctxt)

let rec extract_big_map_updates :
    type a.
    context ->
    (context -> (context * Big_map.id) tzresult Lwt.t) ->
    unparsing_mode ->
    Ids.t ->
    Contract.big_map_diff list ->
    a ty ->
    a ->
    (context * a * Ids.t * Contract.big_map_diff list) tzresult Lwt.t =
 fun ctxt fresh mode ids acc ty x ->
  match (ty, x) with
  | (Big_map_t (_, _, _), map) ->
      diff_of_big_map ctxt fresh mode ids map
      >>=? fun (diff, id, ctxt) ->
      let (module Map) = map.diff in
      let map = {map with diff = empty_map Map.key_ty; id = Some id} in
      return (ctxt, map, Ids.add id ids, diff :: acc)
  | (Pair_t ((tyl, _, _), (tyr, _, _), _, true), (xl, xr)) ->
      Lwt.return (Gas.consume ctxt Typecheck_costs.cycle)
      >>=? fun ctxt ->
      extract_big_map_updates ctxt fresh mode ids acc tyl xl
      >>=? fun (ctxt, xl, ids, acc) ->
      extract_big_map_updates ctxt fresh mode ids acc tyr xr
      >>=? fun (ctxt, xr, ids, acc) -> return (ctxt, (xl, xr), ids, acc)
  | (Union_t ((ty, _), (_, _), _, true), L x) ->
      Lwt.return (Gas.consume ctxt Typecheck_costs.cycle)
      >>=? fun ctxt ->
      extract_big_map_updates ctxt fresh mode ids acc ty x
      >>=? fun (ctxt, x, ids, acc) -> return (ctxt, L x, ids, acc)
  | (Union_t ((_, _), (ty, _), _, true), R x) ->
      Lwt.return (Gas.consume ctxt Typecheck_costs.cycle)
      >>=? fun ctxt ->
      extract_big_map_updates ctxt fresh mode ids acc ty x
      >>=? fun (ctxt, x, ids, acc) -> return (ctxt, R x, ids, acc)
  | (Option_t (ty, _, true), Some x) ->
      Lwt.return (Gas.consume ctxt Typecheck_costs.cycle)
      >>=? fun ctxt ->
      extract_big_map_updates ctxt fresh mode ids acc ty x
      >>=? fun (ctxt, x, ids, acc) -> return (ctxt, Some x, ids, acc)
  | (List_t (ty, _, true), l) ->
      fold_left_s
        (fun (ctxt, l, ids, acc) x ->
          Lwt.return (Gas.consume ctxt Typecheck_costs.cycle)
          >>=? fun ctxt ->
          extract_big_map_updates ctxt fresh mode ids acc ty x
          >>=? fun (ctxt, x, ids, acc) -> return (ctxt, x :: l, ids, acc))
        (ctxt, [], ids, acc)
        l
      >>=? fun (ctxt, l, ids, acc) -> return (ctxt, List.rev l, ids, acc)
  | (Map_t (_, ty, _, true), ((module M) as m)) ->
      Lwt.return
        (Gas.consume ctxt (Michelson_v1_gas.Cost_of.Legacy.map_to_list m))
      >>=? fun ctxt ->
      fold_left_s
        (fun (ctxt, m, ids, acc) (k, x) ->
          Lwt.return (Gas.consume ctxt Typecheck_costs.cycle)
          >>=? fun ctxt ->
          extract_big_map_updates ctxt fresh mode ids acc ty x
          >>=? fun (ctxt, x, ids, acc) ->
          return (ctxt, M.OPS.add k x m, ids, acc))
        (ctxt, M.OPS.empty, ids, acc)
        (M.OPS.bindings (fst M.boxed))
      >>=? fun (ctxt, m, ids, acc) ->
      let module M = struct
        module OPS = M.OPS

        type key = M.key

        type value = M.value

        let key_ty = M.key_ty

        let boxed = (m, snd M.boxed)
      end in
      return
        ( ctxt,
          (module M : Boxed_map with type key = M.key and type value = M.value),
          ids,
          acc )
  | (Option_t (_, _, true), None) ->
      return (ctxt, None, ids, acc)
  | (List_t (_, _, false), v) ->
      return (ctxt, v, ids, acc)
  | (Map_t (_, _, _, false), v) ->
      return (ctxt, v, ids, acc)
  | (Option_t (_, _, false), None) ->
      return (ctxt, None, ids, acc)
  | (Pair_t (_, _, _, false), v) ->
      return (ctxt, v, ids, acc)
  | (Union_t (_, _, _, false), v) ->
      return (ctxt, v, ids, acc)
  | (Option_t (_, _, false), v) ->
      return (ctxt, v, ids, acc)
  | (Chain_id_t _, v) ->
      return (ctxt, v, ids, acc)
  | (Set_t (_, _), v) ->
      return (ctxt, v, ids, acc)
  | (Unit_t _, v) ->
      return (ctxt, v, ids, acc)
  | (Int_t _, v) ->
      return (ctxt, v, ids, acc)
  | (Nat_t _, v) ->
      return (ctxt, v, ids, acc)
  | (Signature_t _, v) ->
      return (ctxt, v, ids, acc)
  | (String_t _, v) ->
      return (ctxt, v, ids, acc)
  | (Bytes_t _, v) ->
      return (ctxt, v, ids, acc)
  | (Mutez_t _, v) ->
      return (ctxt, v, ids, acc)
  | (Key_hash_t _, v) ->
      return (ctxt, v, ids, acc)
  | (Key_t _, v) ->
      return (ctxt, v, ids, acc)
  | (Timestamp_t _, v) ->
      return (ctxt, v, ids, acc)
  | (Address_t _, v) ->
      return (ctxt, v, ids, acc)
  | (Bool_t _, v) ->
      return (ctxt, v, ids, acc)
  | (Lambda_t (_, _, _), v) ->
      return (ctxt, v, ids, acc)
  | (Contract_t (_, _), v) ->
      return (ctxt, v, ids, acc)
  | (Operation_t _, _) ->
      assert false

(* called only on parameters and storage, which cannot contain operations *)

let collect_big_maps ctxt ty x =
  let rec collect :
      type a. context -> a ty -> a -> Ids.t -> (Ids.t * context) tzresult =
   fun ctxt ty x acc ->
    match (ty, x) with
    | (Big_map_t (_, _, _), {id = Some id}) ->
        Gas.consume ctxt Typecheck_costs.cycle
        >>? fun ctxt -> ok (Ids.add id acc, ctxt)
    | (Pair_t ((tyl, _, _), (tyr, _, _), _, true), (xl, xr)) ->
        collect ctxt tyl xl acc >>? fun (acc, ctxt) -> collect ctxt tyr xr acc
    | (Union_t ((ty, _), (_, _), _, true), L x) ->
        collect ctxt ty x acc
    | (Union_t ((_, _), (ty, _), _, true), R x) ->
        collect ctxt ty x acc
    | (Option_t (ty, _, true), Some x) ->
        collect ctxt ty x acc
    | (List_t (ty, _, true), l) ->
        List.fold_left
          (fun acc x -> acc >>? fun (acc, ctxt) -> collect ctxt ty x acc)
          (ok (acc, ctxt))
          l
    | (Map_t (_, ty, _, true), m) ->
        map_fold
          (fun _ v acc -> acc >>? fun (acc, ctxt) -> collect ctxt ty v acc)
          m
          (ok (acc, ctxt))
    | (List_t (_, _, false), _) ->
        ok (acc, ctxt)
    | (Map_t (_, _, _, false), _) ->
        ok (acc, ctxt)
    | (Big_map_t (_, _, _), {id = None}) ->
        ok (acc, ctxt)
    | (Option_t (_, _, true), None) ->
        ok (acc, ctxt)
    | (Option_t (_, _, false), _) ->
        ok (acc, ctxt)
    | (Union_t (_, _, _, false), _) ->
        ok (acc, ctxt)
    | (Pair_t (_, _, _, false), _) ->
        ok (acc, ctxt)
    | (Chain_id_t _, _) ->
        ok (acc, ctxt)
    | (Set_t (_, _), _) ->
        ok (acc, ctxt)
    | (Unit_t _, _) ->
        ok (acc, ctxt)
    | (Int_t _, _) ->
        ok (acc, ctxt)
    | (Nat_t _, _) ->
        ok (acc, ctxt)
    | (Signature_t _, _) ->
        ok (acc, ctxt)
    | (String_t _, _) ->
        ok (acc, ctxt)
    | (Bytes_t _, _) ->
        ok (acc, ctxt)
    | (Mutez_t _, _) ->
        ok (acc, ctxt)
    | (Key_hash_t _, _) ->
        ok (acc, ctxt)
    | (Key_t _, _) ->
        ok (acc, ctxt)
    | (Timestamp_t _, _) ->
        ok (acc, ctxt)
    | (Address_t _, _) ->
        ok (acc, ctxt)
    | (Bool_t _, _) ->
        ok (acc, ctxt)
    | (Lambda_t (_, _, _), _) ->
        ok (acc, ctxt)
    | (Contract_t (_, _), _) ->
        ok (acc, ctxt)
    | (Operation_t _, _) ->
        assert false
   (* called only on parameters and storage, which cannot contain operations *)
  in
  Lwt.return (collect ctxt ty x no_big_map_id)

let extract_big_map_diff ctxt mode ~temporary ~to_duplicate ~to_update ty v =
  let to_duplicate = Ids.diff to_duplicate to_update in
  let fresh =
    if temporary then fun c -> return (Big_map.fresh_temporary c)
    else Big_map.fresh
  in
  extract_big_map_updates ctxt fresh mode to_duplicate [] ty v
  >>=? fun (ctxt, v, alive, diffs) ->
  let diffs =
    if temporary then diffs
    else
      let dead = Ids.diff to_update alive in
      Ids.fold (fun id acc -> Contract.Clear id :: acc) dead [] :: diffs
  in
  match diffs with
  | [] ->
      return (v, None, ctxt)
  | diffs ->
      return (v, Some (List.flatten diffs (* do not reverse *)), ctxt)

let list_of_big_map_ids ids = Ids.elements ids

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Import Alpha_context.

Import Micheline.

Import Script.

Import Script_typed_ir.

Import Script_tc_errors.

Import Script_ir_annot.

Module Typecheck_costs := Michelson_v1_gas.Cost_of.Typechecking.

Module Unparse_costs := Michelson_v1_gas.Cost_of.Unparse.

Reserved Notation "'ex_comparable_ty".

Inductive ex_comparable_ty_gadt : Set :=
| Ex_comparable_ty : forall {a : Set},
  Tezos_raw_protocol_alpha.Script_typed_ir.comparable_ty a ->
  ex_comparable_ty_gadt

where "'ex_comparable_ty" := (ex_comparable_ty_gadt).

Definition ex_comparable_ty := 'ex_comparable_ty.

Reserved Notation "'ex_ty".

Inductive ex_ty_gadt : Set :=
| Ex_ty : forall {a : Set},
  Tezos_raw_protocol_alpha.Script_typed_ir.ty a -> ex_ty_gadt

where "'ex_ty" := (ex_ty_gadt).

Definition ex_ty := 'ex_ty.

Reserved Notation "'ex_stack_ty".

Inductive ex_stack_ty_gadt : Set :=
| Ex_stack_ty : forall {a : Set},
  Tezos_raw_protocol_alpha.Script_typed_ir.stack_ty a -> ex_stack_ty_gadt

where "'ex_stack_ty" := (ex_stack_ty_gadt).

Definition ex_stack_ty := 'ex_stack_ty.

Reserved Notation "'tc_context".

Inductive tc_context_gadt : Set :=
| Lambda : tc_context_gadt
| Dip : forall {a : Set},
  Tezos_raw_protocol_alpha.Script_typed_ir.stack_ty a -> tc_context_gadt ->
  tc_context_gadt
| Toplevel : forall {param sto : Set},
  Tezos_raw_protocol_alpha.Script_typed_ir.ty sto ->
  Tezos_raw_protocol_alpha.Script_typed_ir.ty param -> option string -> bool ->
  tc_context_gadt

where "'tc_context" := (tc_context_gadt).

Definition tc_context := 'tc_context.

Inductive unparsing_mode : Set :=
| Optimized : unparsing_mode
| Readable : unparsing_mode.

Definition type_logger :=
  Z ->
  list
    (Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
      Tezos_raw_protocol_alpha.Alpha_context.Script.annot) ->
  list
    (Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
      Tezos_raw_protocol_alpha.Alpha_context.Script.annot) -> unit.

Definition add_dip {A : Set}
  (ty : Tezos_raw_protocol_alpha.Script_typed_ir.ty A)
  (annot : option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot)
  (prev : tc_context) : tc_context :=
  match prev with
  | Lambda | Toplevel _ =>
    Dip
      (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t ty
        Tezos_raw_protocol_alpha.Script_typed_ir.Empty_t annot) prev
  | Dip stack _ =>
    Dip (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t ty stack annot) prev
  end.

Fixpoint comparable_type_size {a t : Set}
  (ty : Tezos_raw_protocol_alpha.Script_typed_ir.comparable_struct t a) : Z :=
  match ty with
  | Tezos_raw_protocol_alpha.Script_typed_ir.Int_key _ => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.Nat_key _ => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.String_key _ => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_key _ => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_key _ => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.Bool_key _ => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_key _ => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_key _ => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.Address_key _ => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.Pair_key _ (t, _) _ =>
    op_plus 1 (comparable_type_size t)
  end.

Fixpoint type_size {t : Set}
  (ty : Tezos_raw_protocol_alpha.Script_typed_ir.ty t) : Z :=
  match ty with
  | Tezos_raw_protocol_alpha.Script_typed_ir.Unit_t _ => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.Int_t _ => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t _ => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.Signature_t _ => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_t _ => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.String_t _ => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_t _ => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_t _ => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.Key_t _ => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_t _ => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.Address_t _ => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t _ => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.Operation_t _ => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t (l, _, _) (r, _, _) _ _ =>
    op_plus (op_plus 1 (type_size l)) (type_size r)
  | Tezos_raw_protocol_alpha.Script_typed_ir.Union_t (l, _) (r, _) _ _ =>
    op_plus (op_plus 1 (type_size l)) (type_size r)
  | Tezos_raw_protocol_alpha.Script_typed_ir.Lambda_t arg ret _ =>
    op_plus (op_plus 1 (type_size arg)) (type_size ret)
  | Tezos_raw_protocol_alpha.Script_typed_ir.Option_t t _ _ =>
    op_plus 1 (type_size t)
  | Tezos_raw_protocol_alpha.Script_typed_ir.List_t t _ _ =>
    op_plus 1 (type_size t)
  | Tezos_raw_protocol_alpha.Script_typed_ir.Set_t k _ =>
    op_plus 1 (comparable_type_size k)
  | Tezos_raw_protocol_alpha.Script_typed_ir.Map_t k v _ _ =>
    op_plus (op_plus 1 (comparable_type_size k)) (type_size v)
  | Tezos_raw_protocol_alpha.Script_typed_ir.Big_map_t k v _ =>
    op_plus (op_plus 1 (comparable_type_size k)) (type_size v)
  | Tezos_raw_protocol_alpha.Script_typed_ir.Contract_t arg _ =>
    op_plus 1 (type_size arg)
  | Tezos_raw_protocol_alpha.Script_typed_ir.Chain_id_t _ => 1
  end.

Fixpoint type_size_of_stack_head {st : Set}
  (stack : Tezos_raw_protocol_alpha.Script_typed_ir.stack_ty st) (up_to : Z)
  : Z :=
  match stack with
  | Tezos_raw_protocol_alpha.Script_typed_ir.Empty_t => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Item_t head tail _annot =>
    if op_gt up_to 0 then
      Compare.Int.max (type_size head)
        (type_size_of_stack_head tail (op_minus up_to 1))
    else
      0
  end.

Definition number_of_generated_growing_types {a b : Set}
  (function_parameter : Tezos_raw_protocol_alpha.Script_typed_ir.instr b a)
  : Z :=
  match function_parameter with
  | Tezos_raw_protocol_alpha.Script_typed_ir.Drop => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Dup => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Swap => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Const _ => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.Cons_pair => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.Car => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Cdr => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Cons_some => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.Cons_none _ => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.If_none _ _ => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Left => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Right => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.If_left _ _ => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Cons_list => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.Nil => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.If_cons _ _ => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.List_map _ => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.List_size => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.List_iter _ => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.Empty_set _ => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.Set_iter _ => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Set_mem => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Set_update => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Set_size => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Empty_map _ _ => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.Map_map _ => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.Map_iter _ => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.Map_mem => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Map_get => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Map_update => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Map_size => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Empty_big_map _ _ => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.Big_map_get => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Big_map_update => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Big_map_mem => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Concat_string => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Concat_string_pair => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Slice_string => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.String_size => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Concat_bytes => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Concat_bytes_pair => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Slice_bytes => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_size => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Add_seconds_to_timestamp => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Add_timestamp_to_seconds => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Sub_timestamp_seconds => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Diff_timestamps => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Add_tez => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Sub_tez => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Mul_teznat => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Mul_nattez => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Ediv_teznat => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Ediv_tez => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Or => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.And => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Xor => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Not => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Is_nat => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Neg_nat => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Neg_int => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Abs_int => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Int_nat => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Add_intint => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Add_intnat => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Add_natint => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Add_natnat => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Sub_int => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Mul_intint => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Mul_intnat => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Mul_natint => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Mul_natnat => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Ediv_intint => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Ediv_intnat => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Ediv_natint => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Ediv_natnat => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Lsl_nat => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Lsr_nat => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Or_nat => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.And_nat => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.And_int_nat => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Xor_nat => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Not_nat => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Not_int => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Seq _ _ => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.If _ _ => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Loop _ => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Loop_left _ => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Dip _ => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Exec => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Apply _ => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Lambda _ => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.Failwith _ => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.Nop => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Compare _ => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.Eq => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Neq => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Lt => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Gt => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Le => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Ge => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Address => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Contract _ _ => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.Transfer_tokens => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.Create_account => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Implicit_account => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Create_contract _ _ _ _ => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.Create_contract_2 _ _ _ _ => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.Now => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Balance => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Check_signature => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Hash_key => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Blake2b => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Sha256 => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Sha512 => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Steps_to_quota => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Source => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Sender => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Self _ _ => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.Amount => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Set_delegate => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Pack _ => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Unpack _ => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.Dig _ _ => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Dug _ _ => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Dipn _ _ _ => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Dropn _ _ => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.ChainId => 0
  end.

Definition location {A B : Set}
  (function_parameter :
    Tezos_protocol_environment_alpha__Environment.Micheline.node A B) : A :=
  let
    'Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc _ _ _ |
      Tezos_protocol_environment_alpha__Environment.Micheline.Int loc _ |
      Tezos_protocol_environment_alpha__Environment.Micheline.String loc _ |
      Tezos_protocol_environment_alpha__Environment.Micheline.Bytes loc _ |
      Tezos_protocol_environment_alpha__Environment.Micheline.Seq loc _ :=
    function_parameter in
  loc.

Definition kind {A B : Set}
  (function_parameter :
    Tezos_protocol_environment_alpha__Environment.Micheline.node A B)
  : Tezos_raw_protocol_alpha.Script_tc_errors.kind :=
  match function_parameter with
  | Tezos_protocol_environment_alpha__Environment.Micheline.Int _ _ =>
    Tezos_raw_protocol_alpha.Script_tc_errors.Int_kind
  | Tezos_protocol_environment_alpha__Environment.Micheline.String _ _ =>
    Tezos_raw_protocol_alpha.Script_tc_errors.String_kind
  | Tezos_protocol_environment_alpha__Environment.Micheline.Bytes _ _ =>
    Tezos_raw_protocol_alpha.Script_tc_errors.Bytes_kind
  | Tezos_protocol_environment_alpha__Environment.Micheline.Prim _ _ _ _ =>
    Tezos_raw_protocol_alpha.Script_tc_errors.Prim_kind
  | Tezos_protocol_environment_alpha__Environment.Micheline.Seq _ _ =>
    Tezos_raw_protocol_alpha.Script_tc_errors.Seq_kind
  end.

Definition namespace
  (function_parameter : Tezos_raw_protocol_alpha.Alpha_context.Script.prim)
  : Tezos_raw_protocol_alpha.Script_tc_errors.namespace :=
  match function_parameter with
  |
    Tezos_raw_protocol_alpha.Alpha_context.Script.K_parameter |
      Tezos_raw_protocol_alpha.Alpha_context.Script.K_storage |
      Tezos_raw_protocol_alpha.Alpha_context.Script.K_code =>
    Tezos_raw_protocol_alpha.Script_tc_errors.Keyword_namespace
  |
    Tezos_raw_protocol_alpha.Alpha_context.Script.D_False |
      Tezos_raw_protocol_alpha.Alpha_context.Script.D_Elt |
      Tezos_raw_protocol_alpha.Alpha_context.Script.D_Left |
      Tezos_raw_protocol_alpha.Alpha_context.Script.D_None |
      Tezos_raw_protocol_alpha.Alpha_context.Script.D_Pair |
      Tezos_raw_protocol_alpha.Alpha_context.Script.D_Right |
      Tezos_raw_protocol_alpha.Alpha_context.Script.D_Some |
      Tezos_raw_protocol_alpha.Alpha_context.Script.D_True |
      Tezos_raw_protocol_alpha.Alpha_context.Script.D_Unit =>
    Tezos_raw_protocol_alpha.Script_tc_errors.Constant_namespace
  |
    Tezos_raw_protocol_alpha.Alpha_context.Script.I_PACK |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_UNPACK |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_BLAKE2B |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_SHA256 |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_SHA512 |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_ABS |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_ADD |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_AMOUNT |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_AND |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_BALANCE |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_CAR |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_CDR |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_CHAIN_ID |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_CHECK_SIGNATURE |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_COMPARE |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_CONCAT |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_CONS |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_CREATE_ACCOUNT |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_CREATE_CONTRACT |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_IMPLICIT_ACCOUNT |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_DIP |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_DROP |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_DUP |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_EDIV |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_EMPTY_BIG_MAP |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_EMPTY_MAP |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_EMPTY_SET |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_EQ |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_EXEC |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_APPLY |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_FAILWITH |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_GE |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_GET |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_GT |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_HASH_KEY |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_IF |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_IF_CONS |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_IF_LEFT |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_IF_NONE |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_INT |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_LAMBDA |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_LE |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_LEFT |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_LOOP |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_LSL |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_LSR |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_LT |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_MAP |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_MEM |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_MUL |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_NEG |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_NEQ |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_NIL |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_NONE |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_NOT |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_NOW |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_OR |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_PAIR |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_PUSH |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_RIGHT |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_SIZE |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_SOME |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_SOURCE |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_SENDER |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_SELF |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_SLICE |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_STEPS_TO_QUOTA |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_SUB |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_SWAP |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_TRANSFER_TOKENS |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_SET_DELEGATE |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_UNIT |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_UPDATE |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_XOR |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_ITER |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_LOOP_LEFT |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_ADDRESS |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_CONTRACT |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_ISNAT |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_CAST |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_RENAME |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_DIG |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_DUG =>
    Tezos_raw_protocol_alpha.Script_tc_errors.Instr_namespace
  |
    Tezos_raw_protocol_alpha.Alpha_context.Script.T_bool |
      Tezos_raw_protocol_alpha.Alpha_context.Script.T_contract |
      Tezos_raw_protocol_alpha.Alpha_context.Script.T_int |
      Tezos_raw_protocol_alpha.Alpha_context.Script.T_key |
      Tezos_raw_protocol_alpha.Alpha_context.Script.T_key_hash |
      Tezos_raw_protocol_alpha.Alpha_context.Script.T_lambda |
      Tezos_raw_protocol_alpha.Alpha_context.Script.T_list |
      Tezos_raw_protocol_alpha.Alpha_context.Script.T_map |
      Tezos_raw_protocol_alpha.Alpha_context.Script.T_big_map |
      Tezos_raw_protocol_alpha.Alpha_context.Script.T_nat |
      Tezos_raw_protocol_alpha.Alpha_context.Script.T_option |
      Tezos_raw_protocol_alpha.Alpha_context.Script.T_or |
      Tezos_raw_protocol_alpha.Alpha_context.Script.T_pair |
      Tezos_raw_protocol_alpha.Alpha_context.Script.T_set |
      Tezos_raw_protocol_alpha.Alpha_context.Script.T_signature |
      Tezos_raw_protocol_alpha.Alpha_context.Script.T_string |
      Tezos_raw_protocol_alpha.Alpha_context.Script.T_bytes |
      Tezos_raw_protocol_alpha.Alpha_context.Script.T_mutez |
      Tezos_raw_protocol_alpha.Alpha_context.Script.T_timestamp |
      Tezos_raw_protocol_alpha.Alpha_context.Script.T_unit |
      Tezos_raw_protocol_alpha.Alpha_context.Script.T_operation |
      Tezos_raw_protocol_alpha.Alpha_context.Script.T_address |
      Tezos_raw_protocol_alpha.Alpha_context.Script.T_chain_id =>
    Tezos_raw_protocol_alpha.Script_tc_errors.Type_namespace
  end.

Definition unexpected
  (expr :
    Tezos_protocol_environment_alpha__Environment.Micheline.node
      Tezos_raw_protocol_alpha.Alpha_context.Script.location
      Tezos_raw_protocol_alpha.Alpha_context.Script.prim)
  (exp_kinds : list Tezos_raw_protocol_alpha.Script_tc_errors.kind)
  (exp_ns : Tezos_raw_protocol_alpha.Script_tc_errors.namespace)
  (exp_prims : list Tezos_raw_protocol_alpha.Alpha_context.Script.prim)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.__error :=
  match expr with
  | Tezos_protocol_environment_alpha__Environment.Micheline.Int loc _ =>
    Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_kind loc
      (cons Tezos_raw_protocol_alpha.Script_tc_errors.Prim_kind exp_kinds)
      Tezos_raw_protocol_alpha.Script_tc_errors.Int_kind
  | Tezos_protocol_environment_alpha__Environment.Micheline.String loc _ =>
    Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_kind loc
      (cons Tezos_raw_protocol_alpha.Script_tc_errors.Prim_kind exp_kinds)
      Tezos_raw_protocol_alpha.Script_tc_errors.String_kind
  | Tezos_protocol_environment_alpha__Environment.Micheline.Bytes loc _ =>
    Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_kind loc
      (cons Tezos_raw_protocol_alpha.Script_tc_errors.Prim_kind exp_kinds)
      Tezos_raw_protocol_alpha.Script_tc_errors.Bytes_kind
  | Tezos_protocol_environment_alpha__Environment.Micheline.Seq loc _ =>
    Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_kind loc
      (cons Tezos_raw_protocol_alpha.Script_tc_errors.Prim_kind exp_kinds)
      Tezos_raw_protocol_alpha.Script_tc_errors.Seq_kind
  | Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc name _ _ =>
    match ((namespace name), exp_ns) with
    |
      (Tezos_raw_protocol_alpha.Script_tc_errors.Type_namespace,
        Tezos_raw_protocol_alpha.Script_tc_errors.Type_namespace) |
        (Tezos_raw_protocol_alpha.Script_tc_errors.Instr_namespace,
          Tezos_raw_protocol_alpha.Script_tc_errors.Instr_namespace) |
        (Tezos_raw_protocol_alpha.Script_tc_errors.Constant_namespace,
          Tezos_raw_protocol_alpha.Script_tc_errors.Constant_namespace) =>
      Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_primitive
        loc exp_prims name
    | (ns, _) =>
      Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_namespace
        loc name exp_ns ns
    end
  end.

Definition check_kind {A : Set}
  (kinds : list Tezos_raw_protocol_alpha.Script_tc_errors.kind)
  (expr :
    Tezos_protocol_environment_alpha__Environment.Micheline.node
      Tezos_raw_protocol_alpha.Alpha_context.Script.location A)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
  let kind := kind expr in
  if List.mem kind kinds then
    return_unit
  else
    let loc := location expr in
    fail
      (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_kind
        loc kinds kind).

Definition wrap_compare {A B : Set}
  (compare :
    A -> B -> Tezos_protocol_environment_alpha__Environment.Compare.Int.t)
  (a : A) (b : B) : Z :=
  let res := compare a b in
  if op_eq res 0 then
    0
  else
    if op_gt res 0 then
      1
    else
      (-1).

Fixpoint compare_comparable {a s : Set}
  (kind : Tezos_raw_protocol_alpha.Script_typed_ir.comparable_struct a s)
  : a -> a -> Z :=
  match kind with
  | Tezos_raw_protocol_alpha.Script_typed_ir.String_key _ =>
    wrap_compare Compare.String.compare
  | Tezos_raw_protocol_alpha.Script_typed_ir.Bool_key _ =>
    wrap_compare Compare.Bool.compare
  | Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_key _ =>
    wrap_compare Tez.compare
  | Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_key _ =>
    wrap_compare Signature.Public_key_hash.compare
  | Tezos_raw_protocol_alpha.Script_typed_ir.Int_key _ =>
    wrap_compare Script_int.compare
  | Tezos_raw_protocol_alpha.Script_typed_ir.Nat_key _ =>
    wrap_compare Script_int.compare
  | Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_key _ =>
    wrap_compare Script_timestamp.compare
  | Tezos_raw_protocol_alpha.Script_typed_ir.Address_key _ =>
    op_atat wrap_compare
      (fun function_parameter =>
        let '(x, ex) := function_parameter in
        fun function_parameter =>
          let '(y, ey) := function_parameter in
          let lres := Contract.compare x y in
          if op_eq lres 0 then
            Compare.String.compare ex ey
          else
            lres)
  | Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_key _ =>
    wrap_compare MBytes.compare
  | Tezos_raw_protocol_alpha.Script_typed_ir.Pair_key (tl, _) (tr, _) _ =>
    fun function_parameter =>
      let '(lx, rx) := function_parameter in
      fun function_parameter =>
        let '(ly, ry) := function_parameter in
        let lres := compare_comparable tl lx ly in
        if op_eq lres 0 then
          compare_comparable tr rx ry
        else
          lres
  end.

Definition empty_set {a : Set}
  (ty : Tezos_raw_protocol_alpha.Script_typed_ir.comparable_ty a)
  : Tezos_raw_protocol_alpha.Script_typed_ir.set a :=
  let OPS :=
    (* ❌ Applications of functors are not supported for first-class module values *)
    unsupported_functor_application in
  existT _ _
    {|
      Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_set.elt_ty := ty;
      Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_set.OPS := OPS;
      Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_set.boxed := OPS.empty;
      Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_set.size := 0
      |}.

Definition set_update {a : Set}
  (v : a) (b : bool) (Box : Tezos_raw_protocol_alpha.Script_typed_ir.set a)
  : Tezos_raw_protocol_alpha.Script_typed_ir.set a :=
  let Box := projT2 Box in
  existT _ _
    {|
      Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_set.elt_ty :=
        Box.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_set.elt_ty);
      Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_set.OPS :=
        Box.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_set.OPS);
      Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_set.boxed :=
        if b then
          Box.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_set.OPS).(Tezos_protocol_environment_alpha__Environment.SET.S.add)
            v Box.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_set.boxed)
        else
          Box.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_set.OPS).(Tezos_protocol_environment_alpha__Environment.SET.S.remove)
            v Box.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_set.boxed);
      Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_set.size :=
        let mem :=
          Box.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_set.OPS).(Tezos_protocol_environment_alpha__Environment.SET.S.mem)
            v Box.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_set.boxed) in
        if mem then
          if b then
            Box.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_set.size)
          else
            op_minus
              Box.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_set.size) 1
        else
          if b then
            op_plus
              Box.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_set.size) 1
          else
            Box.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_set.size)
      |}.

Definition set_mem {elt : Set}
  (v : elt) (Box : Tezos_raw_protocol_alpha.Script_typed_ir.set elt) : bool :=
  let Box := projT2 Box in
  Box.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_set.OPS).(Tezos_protocol_environment_alpha__Environment.SET.S.mem)
    v Box.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_set.boxed).

Definition set_fold {acc elt : Set}
  (f : elt -> acc -> acc)
  (Box : Tezos_raw_protocol_alpha.Script_typed_ir.set elt) : acc -> acc :=
  let Box := projT2 Box in
  Box.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_set.OPS).(Tezos_protocol_environment_alpha__Environment.SET.S.fold)
    f Box.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_set.boxed).

Definition set_size {elt : Set}
  (Box : Tezos_raw_protocol_alpha.Script_typed_ir.set elt)
  : Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
    Tezos_raw_protocol_alpha.Alpha_context.Script_int.n :=
  let Box := projT2 Box in
  abs (of_int Box.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_set.size)).

Definition map_key_ty {a b : Set}
  (Box : Tezos_raw_protocol_alpha.Script_typed_ir.map a b)
  : Tezos_raw_protocol_alpha.Script_typed_ir.comparable_ty a :=
  let Box := projT2 Box in
  Box.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_map.key_ty).

Definition empty_map {a b : Set}
  (ty : Tezos_raw_protocol_alpha.Script_typed_ir.comparable_ty a)
  : Tezos_raw_protocol_alpha.Script_typed_ir.map a b :=
  let OPS :=
    (* ❌ Applications of functors are not supported for first-class module values *)
    unsupported_functor_application in
  existT _ _
    {|
      Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_map.key_ty := ty;
      Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_map.OPS := OPS;
      (* ❌ This kind of definition of value for first-class modules is not handled *)
      Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_map.boxed := unhandled
      |}.

Definition map_get {key value : Set}
  (k : key) (Box : Tezos_raw_protocol_alpha.Script_typed_ir.map key value)
  : option value :=
  let Box := projT2 Box in
  Box.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_map.OPS).(Tezos_protocol_environment_alpha__Environment.MAP.S.find_opt)
    k (fst Box.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_map.boxed)).

Definition map_update {a b : Set}
  (k : a) (v : option b)
  (Box : Tezos_raw_protocol_alpha.Script_typed_ir.map a b)
  : Tezos_raw_protocol_alpha.Script_typed_ir.map a b :=
  let Box := projT2 Box in
  existT _ _
    {|
      Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_map.key_ty :=
        Box.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_map.key_ty);
      Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_map.OPS :=
        Box.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_map.OPS);
      Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_map.boxed :=
        let '(map, size) :=
          Box.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_map.boxed) in
        let contains :=
          Box.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_map.OPS).(Tezos_protocol_environment_alpha__Environment.MAP.S.mem)
            k map in
        match v with
        | Some v =>
          ((Box.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_map.OPS).(Tezos_protocol_environment_alpha__Environment.MAP.S.add)
            k v map),
            (op_plus size
              (if contains then
                0
              else
                1)))
        | None =>
          ((Box.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_map.OPS).(Tezos_protocol_environment_alpha__Environment.MAP.S.remove)
            k map),
            (op_minus size
              (if contains then
                1
              else
                0)))
        end
      |}.

Definition map_set {a b : Set}
  (k : a) (v : b) (Box : Tezos_raw_protocol_alpha.Script_typed_ir.map a b)
  : Tezos_raw_protocol_alpha.Script_typed_ir.map a b :=
  let Box := projT2 Box in
  existT _ _
    {|
      Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_map.key_ty :=
        Box.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_map.key_ty);
      Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_map.OPS :=
        Box.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_map.OPS);
      Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_map.boxed :=
        let '(map, size) :=
          Box.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_map.boxed) in
        ((Box.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_map.OPS).(Tezos_protocol_environment_alpha__Environment.MAP.S.add)
          k v map),
          (if
            Box.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_map.OPS).(Tezos_protocol_environment_alpha__Environment.MAP.S.mem)
              k map then
            size
          else
            op_plus size 1))
      |}.

Definition map_mem {key value : Set}
  (k : key) (Box : Tezos_raw_protocol_alpha.Script_typed_ir.map key value)
  : bool :=
  let Box := projT2 Box in
  Box.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_map.OPS).(Tezos_protocol_environment_alpha__Environment.MAP.S.mem)
    k (fst Box.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_map.boxed)).

Definition map_fold {acc key value : Set}
  (f : key -> value -> acc -> acc)
  (Box : Tezos_raw_protocol_alpha.Script_typed_ir.map key value) : acc -> acc :=
  let Box := projT2 Box in
  Box.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_map.OPS).(Tezos_protocol_environment_alpha__Environment.MAP.S.fold)
    f (fst Box.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_map.boxed)).

Definition map_size {key value : Set}
  (Box : Tezos_raw_protocol_alpha.Script_typed_ir.map key value)
  : Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
    Tezos_raw_protocol_alpha.Alpha_context.Script_int.n :=
  let Box := projT2 Box in
  abs
    (of_int (snd Box.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_map.boxed))).

Fixpoint ty_of_comparable_ty {a s : Set}
  (function_parameter :
    Tezos_raw_protocol_alpha.Script_typed_ir.comparable_struct a s)
  : Tezos_raw_protocol_alpha.Script_typed_ir.ty a :=
  match function_parameter with
  | Tezos_raw_protocol_alpha.Script_typed_ir.Int_key tname =>
    Tezos_raw_protocol_alpha.Script_typed_ir.Int_t tname
  | Tezos_raw_protocol_alpha.Script_typed_ir.Nat_key tname =>
    Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t tname
  | Tezos_raw_protocol_alpha.Script_typed_ir.String_key tname =>
    Tezos_raw_protocol_alpha.Script_typed_ir.String_t tname
  | Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_key tname =>
    Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_t tname
  | Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_key tname =>
    Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_t tname
  | Tezos_raw_protocol_alpha.Script_typed_ir.Bool_key tname =>
    Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t tname
  | Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_key tname =>
    Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_t tname
  | Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_key tname =>
    Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_t tname
  | Tezos_raw_protocol_alpha.Script_typed_ir.Address_key tname =>
    Tezos_raw_protocol_alpha.Script_typed_ir.Address_t tname
  | Tezos_raw_protocol_alpha.Script_typed_ir.Pair_key (l, al) (r, ar) tname =>
    Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t
      ((ty_of_comparable_ty l), al, None) ((ty_of_comparable_ty r), ar, None)
      tname false
  end.

Fixpoint comparable_ty_of_ty {a : Set}
  (function_parameter : Tezos_raw_protocol_alpha.Script_typed_ir.ty a)
  : option (Tezos_raw_protocol_alpha.Script_typed_ir.comparable_ty a) :=
  match function_parameter with
  | Tezos_raw_protocol_alpha.Script_typed_ir.Int_t tname =>
    Some (Tezos_raw_protocol_alpha.Script_typed_ir.Int_key tname)
  | Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t tname =>
    Some (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_key tname)
  | Tezos_raw_protocol_alpha.Script_typed_ir.String_t tname =>
    Some (Tezos_raw_protocol_alpha.Script_typed_ir.String_key tname)
  | Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_t tname =>
    Some (Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_key tname)
  | Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_t tname =>
    Some (Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_key tname)
  | Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t tname =>
    Some (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_key tname)
  | Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_t tname =>
    Some (Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_key tname)
  | Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_t tname =>
    Some (Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_key tname)
  | Tezos_raw_protocol_alpha.Script_typed_ir.Address_t tname =>
    Some (Tezos_raw_protocol_alpha.Script_typed_ir.Address_key tname)
  |
    Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t (l, al, _) (r, ar, _) pname
      _ =>
    match comparable_ty_of_ty r with
    | None => None
    | Some rty =>
      match comparable_ty_of_ty l with
      | None => None
      | Some (Tezos_raw_protocol_alpha.Script_typed_ir.Pair_key _ _ _) => None
      | Some (Tezos_raw_protocol_alpha.Script_typed_ir.Int_key tname) =>
        Some
          (Tezos_raw_protocol_alpha.Script_typed_ir.Pair_key
            ((Tezos_raw_protocol_alpha.Script_typed_ir.Int_key tname), al)
            (rty, ar) pname)
      | Some (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_key tname) =>
        Some
          (Tezos_raw_protocol_alpha.Script_typed_ir.Pair_key
            ((Tezos_raw_protocol_alpha.Script_typed_ir.Nat_key tname), al)
            (rty, ar) pname)
      | Some (Tezos_raw_protocol_alpha.Script_typed_ir.String_key tname) =>
        Some
          (Tezos_raw_protocol_alpha.Script_typed_ir.Pair_key
            ((Tezos_raw_protocol_alpha.Script_typed_ir.String_key tname), al)
            (rty, ar) pname)
      | Some (Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_key tname) =>
        Some
          (Tezos_raw_protocol_alpha.Script_typed_ir.Pair_key
            ((Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_key tname), al)
            (rty, ar) pname)
      | Some (Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_key tname) =>
        Some
          (Tezos_raw_protocol_alpha.Script_typed_ir.Pair_key
            ((Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_key tname), al)
            (rty, ar) pname)
      | Some (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_key tname) =>
        Some
          (Tezos_raw_protocol_alpha.Script_typed_ir.Pair_key
            ((Tezos_raw_protocol_alpha.Script_typed_ir.Bool_key tname), al)
            (rty, ar) pname)
      | Some (Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_key tname) =>
        Some
          (Tezos_raw_protocol_alpha.Script_typed_ir.Pair_key
            ((Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_key tname), al)
            (rty, ar) pname)
      | Some (Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_key tname) =>
        Some
          (Tezos_raw_protocol_alpha.Script_typed_ir.Pair_key
            ((Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_key tname), al)
            (rty, ar) pname)
      | Some (Tezos_raw_protocol_alpha.Script_typed_ir.Address_key tname) =>
        Some
          (Tezos_raw_protocol_alpha.Script_typed_ir.Pair_key
            ((Tezos_raw_protocol_alpha.Script_typed_ir.Address_key tname), al)
            (rty, ar) pname)
      end
    end
  | _ => None
  end.

Definition add_field_annot {A B : Set}
  (a : option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot)
  (var : option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot)
  (function_parameter :
    Tezos_protocol_environment_alpha__Environment.Micheline.node A B)
  : Tezos_protocol_environment_alpha__Environment.Micheline.node A B :=
  match function_parameter with
  |
    Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc prim args
      annots =>
    Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc prim args
      (op_at annots (op_at (unparse_field_annot a) (unparse_var_annot var)))
  | expr => expr
  end.

Fixpoint unparse_comparable_ty {a s : Set}
  (function_parameter :
    Tezos_raw_protocol_alpha.Script_typed_ir.comparable_struct a s)
  : Tezos_raw_protocol_alpha.Alpha_context.Script.node :=
  match function_parameter with
  | Tezos_raw_protocol_alpha.Script_typed_ir.Int_key tname =>
    Tezos_protocol_environment_alpha__Environment.Micheline.Prim (-1)
      Tezos_raw_protocol_alpha.Alpha_context.Script.T_int []
      (unparse_type_annot tname)
  | Tezos_raw_protocol_alpha.Script_typed_ir.Nat_key tname =>
    Tezos_protocol_environment_alpha__Environment.Micheline.Prim (-1)
      Tezos_raw_protocol_alpha.Alpha_context.Script.T_nat []
      (unparse_type_annot tname)
  | Tezos_raw_protocol_alpha.Script_typed_ir.String_key tname =>
    Tezos_protocol_environment_alpha__Environment.Micheline.Prim (-1)
      Tezos_raw_protocol_alpha.Alpha_context.Script.T_string []
      (unparse_type_annot tname)
  | Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_key tname =>
    Tezos_protocol_environment_alpha__Environment.Micheline.Prim (-1)
      Tezos_raw_protocol_alpha.Alpha_context.Script.T_bytes []
      (unparse_type_annot tname)
  | Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_key tname =>
    Tezos_protocol_environment_alpha__Environment.Micheline.Prim (-1)
      Tezos_raw_protocol_alpha.Alpha_context.Script.T_mutez []
      (unparse_type_annot tname)
  | Tezos_raw_protocol_alpha.Script_typed_ir.Bool_key tname =>
    Tezos_protocol_environment_alpha__Environment.Micheline.Prim (-1)
      Tezos_raw_protocol_alpha.Alpha_context.Script.T_bool []
      (unparse_type_annot tname)
  | Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_key tname =>
    Tezos_protocol_environment_alpha__Environment.Micheline.Prim (-1)
      Tezos_raw_protocol_alpha.Alpha_context.Script.T_key_hash []
      (unparse_type_annot tname)
  | Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_key tname =>
    Tezos_protocol_environment_alpha__Environment.Micheline.Prim (-1)
      Tezos_raw_protocol_alpha.Alpha_context.Script.T_timestamp []
      (unparse_type_annot tname)
  | Tezos_raw_protocol_alpha.Script_typed_ir.Address_key tname =>
    Tezos_protocol_environment_alpha__Environment.Micheline.Prim (-1)
      Tezos_raw_protocol_alpha.Alpha_context.Script.T_address []
      (unparse_type_annot tname)
  | Tezos_raw_protocol_alpha.Script_typed_ir.Pair_key (l, al) (r, ar) pname =>
    let tl := add_field_annot al None (unparse_comparable_ty l) in
    let tr := add_field_annot ar None (unparse_comparable_ty r) in
    Tezos_protocol_environment_alpha__Environment.Micheline.Prim (-1)
      Tezos_raw_protocol_alpha.Alpha_context.Script.T_pair
      (cons tl (cons tr [])) (unparse_type_annot pname)
  end.

Fixpoint unparse_ty_no_lwt {a : Set}
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
  (ty : Tezos_raw_protocol_alpha.Script_typed_ir.ty a)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (Tezos_raw_protocol_alpha.Alpha_context.Script.node *
      Tezos_raw_protocol_alpha.Alpha_context.context) :=
  op_gtgtquestion (Gas.consume ctxt Unparse_costs.cycle)
    (fun ctxt =>
      let __return {B : Set}
        (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
        (function_parameter :
        B *
          list
            (Tezos_protocol_environment_alpha__Environment.Micheline.node Z B) *
          Tezos_protocol_environment_alpha__Environment.Micheline.annot)
        : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_protocol_environment_alpha__Environment.Micheline.node Z B *
            Tezos_raw_protocol_alpha__Alpha_context.context) :=
        let '(name, args, annot) := function_parameter in
        let __result_value :=
          Tezos_protocol_environment_alpha__Environment.Micheline.Prim (-1) name
            args annot in
        op_gtgtquestion
          (Gas.consume ctxt (Unparse_costs.prim_cost (List.length args) annot))
          (fun ctxt => ok (__result_value, ctxt)) in
      match ty with
      | Tezos_raw_protocol_alpha.Script_typed_ir.Unit_t tname =>
        __return ctxt
          (Tezos_raw_protocol_alpha.Alpha_context.Script.T_unit, [],
            (unparse_type_annot tname))
      | Tezos_raw_protocol_alpha.Script_typed_ir.Int_t tname =>
        __return ctxt
          (Tezos_raw_protocol_alpha.Alpha_context.Script.T_int, [],
            (unparse_type_annot tname))
      | Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t tname =>
        __return ctxt
          (Tezos_raw_protocol_alpha.Alpha_context.Script.T_nat, [],
            (unparse_type_annot tname))
      | Tezos_raw_protocol_alpha.Script_typed_ir.String_t tname =>
        __return ctxt
          (Tezos_raw_protocol_alpha.Alpha_context.Script.T_string, [],
            (unparse_type_annot tname))
      | Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_t tname =>
        __return ctxt
          (Tezos_raw_protocol_alpha.Alpha_context.Script.T_bytes, [],
            (unparse_type_annot tname))
      | Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_t tname =>
        __return ctxt
          (Tezos_raw_protocol_alpha.Alpha_context.Script.T_mutez, [],
            (unparse_type_annot tname))
      | Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t tname =>
        __return ctxt
          (Tezos_raw_protocol_alpha.Alpha_context.Script.T_bool, [],
            (unparse_type_annot tname))
      | Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_t tname =>
        __return ctxt
          (Tezos_raw_protocol_alpha.Alpha_context.Script.T_key_hash, [],
            (unparse_type_annot tname))
      | Tezos_raw_protocol_alpha.Script_typed_ir.Key_t tname =>
        __return ctxt
          (Tezos_raw_protocol_alpha.Alpha_context.Script.T_key, [],
            (unparse_type_annot tname))
      | Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_t tname =>
        __return ctxt
          (Tezos_raw_protocol_alpha.Alpha_context.Script.T_timestamp, [],
            (unparse_type_annot tname))
      | Tezos_raw_protocol_alpha.Script_typed_ir.Address_t tname =>
        __return ctxt
          (Tezos_raw_protocol_alpha.Alpha_context.Script.T_address, [],
            (unparse_type_annot tname))
      | Tezos_raw_protocol_alpha.Script_typed_ir.Signature_t tname =>
        __return ctxt
          (Tezos_raw_protocol_alpha.Alpha_context.Script.T_signature, [],
            (unparse_type_annot tname))
      | Tezos_raw_protocol_alpha.Script_typed_ir.Operation_t tname =>
        __return ctxt
          (Tezos_raw_protocol_alpha.Alpha_context.Script.T_operation, [],
            (unparse_type_annot tname))
      | Tezos_raw_protocol_alpha.Script_typed_ir.Chain_id_t tname =>
        __return ctxt
          (Tezos_raw_protocol_alpha.Alpha_context.Script.T_chain_id, [],
            (unparse_type_annot tname))
      | Tezos_raw_protocol_alpha.Script_typed_ir.Contract_t ut tname =>
        op_gtgtquestion (unparse_ty_no_lwt ctxt ut)
          (fun function_parameter =>
            let '(t, ctxt) := function_parameter in
            __return ctxt
              (Tezos_raw_protocol_alpha.Alpha_context.Script.T_contract,
                (cons t []), (unparse_type_annot tname)))
      |
        Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t (utl, l_field, l_var)
          (utr, r_field, r_var) tname _ =>
        let annot := unparse_type_annot tname in
        op_gtgtquestion (unparse_ty_no_lwt ctxt utl)
          (fun function_parameter =>
            let '(utl, ctxt) := function_parameter in
            let tl := add_field_annot l_field l_var utl in
            op_gtgtquestion (unparse_ty_no_lwt ctxt utr)
              (fun function_parameter =>
                let '(utr, ctxt) := function_parameter in
                let tr := add_field_annot r_field r_var utr in
                __return ctxt
                  (Tezos_raw_protocol_alpha.Alpha_context.Script.T_pair,
                    (cons tl (cons tr [])), annot)))
      |
        Tezos_raw_protocol_alpha.Script_typed_ir.Union_t (utl, l_field)
          (utr, r_field) tname _ =>
        let annot := unparse_type_annot tname in
        op_gtgtquestion (unparse_ty_no_lwt ctxt utl)
          (fun function_parameter =>
            let '(utl, ctxt) := function_parameter in
            let tl := add_field_annot l_field None utl in
            op_gtgtquestion (unparse_ty_no_lwt ctxt utr)
              (fun function_parameter =>
                let '(utr, ctxt) := function_parameter in
                let tr := add_field_annot r_field None utr in
                __return ctxt
                  (Tezos_raw_protocol_alpha.Alpha_context.Script.T_or,
                    (cons tl (cons tr [])), annot)))
      | Tezos_raw_protocol_alpha.Script_typed_ir.Lambda_t uta utr tname =>
        op_gtgtquestion (unparse_ty_no_lwt ctxt uta)
          (fun function_parameter =>
            let '(ta, ctxt) := function_parameter in
            op_gtgtquestion (unparse_ty_no_lwt ctxt utr)
              (fun function_parameter =>
                let '(tr, ctxt) := function_parameter in
                __return ctxt
                  (Tezos_raw_protocol_alpha.Alpha_context.Script.T_lambda,
                    (cons ta (cons tr [])), (unparse_type_annot tname))))
      | Tezos_raw_protocol_alpha.Script_typed_ir.Option_t ut tname _ =>
        let annot := unparse_type_annot tname in
        op_gtgtquestion (unparse_ty_no_lwt ctxt ut)
          (fun function_parameter =>
            let '(ut, ctxt) := function_parameter in
            __return ctxt
              (Tezos_raw_protocol_alpha.Alpha_context.Script.T_option,
                (cons ut []), annot))
      | Tezos_raw_protocol_alpha.Script_typed_ir.List_t ut tname _ =>
        op_gtgtquestion (unparse_ty_no_lwt ctxt ut)
          (fun function_parameter =>
            let '(t, ctxt) := function_parameter in
            __return ctxt
              (Tezos_raw_protocol_alpha.Alpha_context.Script.T_list,
                (cons t []), (unparse_type_annot tname)))
      | Tezos_raw_protocol_alpha.Script_typed_ir.Set_t ut tname =>
        let t := unparse_comparable_ty ut in
        __return ctxt
          (Tezos_raw_protocol_alpha.Alpha_context.Script.T_set, (cons t []),
            (unparse_type_annot tname))
      | Tezos_raw_protocol_alpha.Script_typed_ir.Map_t uta utr tname _ =>
        let ta := unparse_comparable_ty uta in
        op_gtgtquestion (unparse_ty_no_lwt ctxt utr)
          (fun function_parameter =>
            let '(tr, ctxt) := function_parameter in
            __return ctxt
              (Tezos_raw_protocol_alpha.Alpha_context.Script.T_map,
                (cons ta (cons tr [])), (unparse_type_annot tname)))
      | Tezos_raw_protocol_alpha.Script_typed_ir.Big_map_t uta utr tname =>
        let ta := unparse_comparable_ty uta in
        op_gtgtquestion (unparse_ty_no_lwt ctxt utr)
          (fun function_parameter =>
            let '(tr, ctxt) := function_parameter in
            __return ctxt
              (Tezos_raw_protocol_alpha.Alpha_context.Script.T_big_map,
                (cons ta (cons tr [])), (unparse_type_annot tname)))
      end).

Definition unparse_ty {A : Set}
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
  (ty : Tezos_raw_protocol_alpha.Script_typed_ir.ty A)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Alpha_context.Script.node *
        Tezos_raw_protocol_alpha.Alpha_context.context)) :=
  Lwt.__return (unparse_ty_no_lwt ctxt ty).

Fixpoint strip_var_annots {A B : Set}
  (function_parameter :
    Tezos_protocol_environment_alpha__Environment.Micheline.node A B)
  : Tezos_protocol_environment_alpha__Environment.Micheline.node A B :=
  match function_parameter with
  |
    (Tezos_protocol_environment_alpha__Environment.Micheline.Int _ _ |
      Tezos_protocol_environment_alpha__Environment.Micheline.String _ _ |
      Tezos_protocol_environment_alpha__Environment.Micheline.Bytes _ _) as atom
    => atom
  | Tezos_protocol_environment_alpha__Environment.Micheline.Seq loc args =>
    Tezos_protocol_environment_alpha__Environment.Micheline.Seq loc
      (List.map strip_var_annots args)
  |
    Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc name args
      annots =>
    let not_var_annot (s : string) : bool :=
      op_ltgt (String.get s 0) "@" % char in
    let annots := List.filter not_var_annot annots in
    Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc name
      (List.map strip_var_annots args) annots
  end.

Definition serialize_ty_for_error {A : Set}
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
  (ty : Tezos_raw_protocol_alpha.Script_typed_ir.ty A)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (Tezos_protocol_environment_alpha__Environment.Micheline.canonical
      Tezos_raw_protocol_alpha.Alpha_context.Script.prim *
      Tezos_raw_protocol_alpha.Alpha_context.context) :=
  op_gtpipequestion
    (op_pipegt (unparse_ty_no_lwt ctxt ty)
      (record_trace
        Tezos_protocol_environment_alpha__Environment.Error_monad.Cannot_serialize_error))
    (fun function_parameter =>
      let '(ty, ctxt) := function_parameter in
      ((strip_locations (strip_var_annots ty)), ctxt)).

Fixpoint unparse_stack {a : Set}
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
  (function_parameter : Tezos_raw_protocol_alpha.Script_typed_ir.stack_ty a)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (list
        (Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
          Tezos_raw_protocol_alpha.Alpha_context.Script.annot) *
        Tezos_raw_protocol_alpha.Alpha_context.context)) :=
  match function_parameter with
  | Tezos_raw_protocol_alpha.Script_typed_ir.Empty_t => __return ([], ctxt)
  | Tezos_raw_protocol_alpha.Script_typed_ir.Item_t ty rest annot =>
    op_gtgteqquestion (unparse_ty ctxt ty)
      (fun function_parameter =>
        let '(uty, ctxt) := function_parameter in
        op_gtgteqquestion (unparse_stack ctxt rest)
          (fun function_parameter =>
            let '(urest, ctxt) := function_parameter in
            __return
              ((cons ((strip_locations uty), (unparse_var_annot annot)) urest),
                ctxt)))
  end.

Definition serialize_stack_for_error {A : Set}
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
  (stack_ty : Tezos_raw_protocol_alpha.Script_typed_ir.stack_ty A)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (list
        (Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
          Tezos_raw_protocol_alpha.Alpha_context.Script.annot) *
        Tezos_raw_protocol_alpha.Alpha_context.context)) :=
  trace
    Tezos_protocol_environment_alpha__Environment.Error_monad.Cannot_serialize_error
    (unparse_stack ctxt stack_ty).

Definition name_of_ty {a : Set}
  (function_parameter : Tezos_raw_protocol_alpha.Script_typed_ir.ty a)
  : option Tezos_raw_protocol_alpha.Script_typed_ir.type_annot :=
  match function_parameter with
  | Tezos_raw_protocol_alpha.Script_typed_ir.Unit_t tname => tname
  | Tezos_raw_protocol_alpha.Script_typed_ir.Int_t tname => tname
  | Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t tname => tname
  | Tezos_raw_protocol_alpha.Script_typed_ir.String_t tname => tname
  | Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_t tname => tname
  | Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_t tname => tname
  | Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t tname => tname
  | Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_t tname => tname
  | Tezos_raw_protocol_alpha.Script_typed_ir.Key_t tname => tname
  | Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_t tname => tname
  | Tezos_raw_protocol_alpha.Script_typed_ir.Address_t tname => tname
  | Tezos_raw_protocol_alpha.Script_typed_ir.Signature_t tname => tname
  | Tezos_raw_protocol_alpha.Script_typed_ir.Operation_t tname => tname
  | Tezos_raw_protocol_alpha.Script_typed_ir.Chain_id_t tname => tname
  | Tezos_raw_protocol_alpha.Script_typed_ir.Contract_t _ tname => tname
  | Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t _ _ tname _ => tname
  | Tezos_raw_protocol_alpha.Script_typed_ir.Union_t _ _ tname _ => tname
  | Tezos_raw_protocol_alpha.Script_typed_ir.Lambda_t _ _ tname => tname
  | Tezos_raw_protocol_alpha.Script_typed_ir.Option_t _ tname _ => tname
  | Tezos_raw_protocol_alpha.Script_typed_ir.List_t _ tname _ => tname
  | Tezos_raw_protocol_alpha.Script_typed_ir.Set_t _ tname => tname
  | Tezos_raw_protocol_alpha.Script_typed_ir.Map_t _ _ tname _ => tname
  | Tezos_raw_protocol_alpha.Script_typed_ir.Big_map_t _ _ tname => tname
  end.

Reserved Notation "'eq".

Inductive eq_gadt : Set :=
| Eq : eq_gadt

where "'eq" := (fun (ta tb : Set) => eq_gadt).

Definition eq := 'eq.

Definition comparable_ty_eq {ta tb : Set}
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
  (ta : Tezos_raw_protocol_alpha.Script_typed_ir.comparable_ty ta)
  (tb : Tezos_raw_protocol_alpha.Script_typed_ir.comparable_ty tb)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (eq (Tezos_raw_protocol_alpha.Script_typed_ir.comparable_ty ta)
      (Tezos_raw_protocol_alpha.Script_typed_ir.comparable_ty tb)) :=
  match (ta, tb) with
  |
    (Tezos_raw_protocol_alpha.Script_typed_ir.Int_key _,
      Tezos_raw_protocol_alpha.Script_typed_ir.Int_key _) =>
    Tezos_protocol_environment_alpha__Environment.Pervasives.Ok Eq
  |
    (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_key _,
      Tezos_raw_protocol_alpha.Script_typed_ir.Nat_key _) =>
    Tezos_protocol_environment_alpha__Environment.Pervasives.Ok Eq
  |
    (Tezos_raw_protocol_alpha.Script_typed_ir.String_key _,
      Tezos_raw_protocol_alpha.Script_typed_ir.String_key _) =>
    Tezos_protocol_environment_alpha__Environment.Pervasives.Ok Eq
  |
    (Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_key _,
      Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_key _) =>
    Tezos_protocol_environment_alpha__Environment.Pervasives.Ok Eq
  |
    (Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_key _,
      Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_key _) =>
    Tezos_protocol_environment_alpha__Environment.Pervasives.Ok Eq
  |
    (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_key _,
      Tezos_raw_protocol_alpha.Script_typed_ir.Bool_key _) =>
    Tezos_protocol_environment_alpha__Environment.Pervasives.Ok Eq
  |
    (Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_key _,
      Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_key _) =>
    Tezos_protocol_environment_alpha__Environment.Pervasives.Ok Eq
  |
    (Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_key _,
      Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_key _) =>
    Tezos_protocol_environment_alpha__Environment.Pervasives.Ok Eq
  |
    (Tezos_raw_protocol_alpha.Script_typed_ir.Address_key _,
      Tezos_raw_protocol_alpha.Script_typed_ir.Address_key _) =>
    Tezos_protocol_environment_alpha__Environment.Pervasives.Ok Eq
  | (_, _) =>
    op_gtgtquestion (serialize_ty_for_error ctxt (ty_of_comparable_ty ta))
      (fun function_parameter =>
        let '(ta, ctxt) := function_parameter in
        op_gtgtquestion (serialize_ty_for_error ctxt (ty_of_comparable_ty tb))
          (fun function_parameter =>
            let '(tb, _ctxt) := function_parameter in
            __error_value
              (Tezos_protocol_environment_alpha__Environment.Error_monad.Inconsistent_types
                ta tb)))
  end.

Definition record_inconsistent {A B C : Set}
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
  (ta : Tezos_raw_protocol_alpha.Script_typed_ir.ty A)
  (tb : Tezos_raw_protocol_alpha.Script_typed_ir.ty B)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult C ->
  Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult C :=
  record_trace_eval
    (fun function_parameter =>
      let 'tt := function_parameter in
      op_gtgtquestion (serialize_ty_for_error ctxt ta)
        (fun function_parameter =>
          let '(ta, ctxt) := function_parameter in
          op_gtpipequestion (serialize_ty_for_error ctxt tb)
            (fun function_parameter =>
              let '(tb, _ctxt) := function_parameter in
              Tezos_protocol_environment_alpha__Environment.Error_monad.Inconsistent_types
                ta tb))).

Definition record_inconsistent_type_annotations {A B C : Set}
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
  (loc : Tezos_raw_protocol_alpha.Alpha_context.Script.location)
  (ta : Tezos_raw_protocol_alpha.Script_typed_ir.ty A)
  (tb : Tezos_raw_protocol_alpha.Script_typed_ir.ty B)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult C ->
  Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult C :=
  record_trace_eval
    (fun function_parameter =>
      let 'tt := function_parameter in
      op_gtgtquestion (serialize_ty_for_error ctxt ta)
        (fun function_parameter =>
          let '(ta, ctxt) := function_parameter in
          op_gtpipequestion (serialize_ty_for_error ctxt tb)
            (fun function_parameter =>
              let '(tb, _ctxt) := function_parameter in
              Tezos_protocol_environment_alpha__Environment.Error_monad.Inconsistent_type_annotations
                loc ta tb))).

Fixpoint ty_eq {ta tb : Set}
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
  (ta : Tezos_raw_protocol_alpha.Script_typed_ir.ty ta)
  (tb : Tezos_raw_protocol_alpha.Script_typed_ir.ty tb)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (eq (Tezos_raw_protocol_alpha.Script_typed_ir.ty ta)
      (Tezos_raw_protocol_alpha.Script_typed_ir.ty tb) *
      Tezos_raw_protocol_alpha.Alpha_context.context) :=
  let ok
    (__eq_value :
    eq (Tezos_raw_protocol_alpha.Script_typed_ir.ty ta)
      (Tezos_raw_protocol_alpha.Script_typed_ir.ty tb)) (ctxt :
    Tezos_raw_protocol_alpha__Alpha_context.context) (nb_args : Z)
    : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (eq (Tezos_raw_protocol_alpha.Script_typed_ir.ty ta)
        (Tezos_raw_protocol_alpha.Script_typed_ir.ty tb) *
        Tezos_raw_protocol_alpha.Alpha_context.context) :=
    op_gtgtquestion
      (Gas.consume ctxt (Typecheck_costs.type_ (op_star 2 nb_args)))
      (fun ctxt =>
        Tezos_protocol_environment_alpha__Environment.Pervasives.Ok
          (__eq_value, ctxt)) in
  op_gtgtquestion (Gas.consume ctxt Typecheck_costs.cycle)
    (fun ctxt =>
      match (ta, tb) with
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Unit_t _,
          Tezos_raw_protocol_alpha.Script_typed_ir.Unit_t _) => ok Eq ctxt 0
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t _,
          Tezos_raw_protocol_alpha.Script_typed_ir.Int_t _) => ok Eq ctxt 0
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t _,
          Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t _) => ok Eq ctxt 0
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Key_t _,
          Tezos_raw_protocol_alpha.Script_typed_ir.Key_t _) => ok Eq ctxt 0
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_t _,
          Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_t _) => ok Eq ctxt 0
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.String_t _,
          Tezos_raw_protocol_alpha.Script_typed_ir.String_t _) => ok Eq ctxt 0
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_t _,
          Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_t _) => ok Eq ctxt 0
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Signature_t _,
          Tezos_raw_protocol_alpha.Script_typed_ir.Signature_t _) =>
        ok Eq ctxt 0
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_t _,
          Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_t _) => ok Eq ctxt 0
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_t _,
          Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_t _) =>
        ok Eq ctxt 0
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Chain_id_t _,
          Tezos_raw_protocol_alpha.Script_typed_ir.Chain_id_t _) => ok Eq ctxt 0
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Address_t _,
          Tezos_raw_protocol_alpha.Script_typed_ir.Address_t _) => ok Eq ctxt 0
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t _,
          Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t _) => ok Eq ctxt 0
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Operation_t _,
          Tezos_raw_protocol_alpha.Script_typed_ir.Operation_t _) =>
        ok Eq ctxt 0
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Map_t tal tar _ _,
          Tezos_raw_protocol_alpha.Script_typed_ir.Map_t tbl tbr _ _) =>
        op_pipegt
          (op_gtgtquestion (comparable_ty_eq ctxt tal tbl)
            (fun function_parameter =>
              let 'Eq := function_parameter in
              op_gtgtquestion (ty_eq ctxt tar tbr)
                (fun function_parameter =>
                  let '(Eq, ctxt) := function_parameter in
                  ok Eq ctxt 2))) (record_inconsistent ctxt ta tb)
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Big_map_t tal tar _,
          Tezos_raw_protocol_alpha.Script_typed_ir.Big_map_t tbl tbr _) =>
        op_pipegt
          (op_gtgtquestion (comparable_ty_eq ctxt tal tbl)
            (fun function_parameter =>
              let 'Eq := function_parameter in
              op_gtgtquestion (ty_eq ctxt tar tbr)
                (fun function_parameter =>
                  let '(Eq, ctxt) := function_parameter in
                  ok Eq ctxt 2))) (record_inconsistent ctxt ta tb)
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Set_t ea _,
          Tezos_raw_protocol_alpha.Script_typed_ir.Set_t eb _) =>
        op_pipegt
          (op_gtgtquestion (comparable_ty_eq ctxt ea eb)
            (fun function_parameter =>
              let 'Eq := function_parameter in
              ok Eq ctxt 1)) (record_inconsistent ctxt ta tb)
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t (tal, _, _) (tar, _, _)
          _ _,
          Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t (tbl, _, _)
            (tbr, _, _) _ _) =>
        op_pipegt
          (op_gtgtquestion (ty_eq ctxt tal tbl)
            (fun function_parameter =>
              let '(Eq, ctxt) := function_parameter in
              op_gtgtquestion (ty_eq ctxt tar tbr)
                (fun function_parameter =>
                  let '(Eq, ctxt) := function_parameter in
                  ok Eq ctxt 2))) (record_inconsistent ctxt ta tb)
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Union_t (tal, _) (tar, _) _ _,
          Tezos_raw_protocol_alpha.Script_typed_ir.Union_t (tbl, _) (tbr, _) _ _)
        =>
        op_pipegt
          (op_gtgtquestion (ty_eq ctxt tal tbl)
            (fun function_parameter =>
              let '(Eq, ctxt) := function_parameter in
              op_gtgtquestion (ty_eq ctxt tar tbr)
                (fun function_parameter =>
                  let '(Eq, ctxt) := function_parameter in
                  ok Eq ctxt 2))) (record_inconsistent ctxt ta tb)
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Lambda_t tal tar _,
          Tezos_raw_protocol_alpha.Script_typed_ir.Lambda_t tbl tbr _) =>
        op_pipegt
          (op_gtgtquestion (ty_eq ctxt tal tbl)
            (fun function_parameter =>
              let '(Eq, ctxt) := function_parameter in
              op_gtgtquestion (ty_eq ctxt tar tbr)
                (fun function_parameter =>
                  let '(Eq, ctxt) := function_parameter in
                  ok Eq ctxt 2))) (record_inconsistent ctxt ta tb)
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Contract_t tal _,
          Tezos_raw_protocol_alpha.Script_typed_ir.Contract_t tbl _) =>
        op_pipegt
          (op_gtgtquestion (ty_eq ctxt tal tbl)
            (fun function_parameter =>
              let '(Eq, ctxt) := function_parameter in
              ok Eq ctxt 1)) (record_inconsistent ctxt ta tb)
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Option_t tva _ _,
          Tezos_raw_protocol_alpha.Script_typed_ir.Option_t tvb _ _) =>
        op_pipegt
          (op_gtgtquestion (ty_eq ctxt tva tvb)
            (fun function_parameter =>
              let '(Eq, ctxt) := function_parameter in
              ok Eq ctxt 1)) (record_inconsistent ctxt ta tb)
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.List_t tva _ _,
          Tezos_raw_protocol_alpha.Script_typed_ir.List_t tvb _ _) =>
        op_pipegt
          (op_gtgtquestion (ty_eq ctxt tva tvb)
            (fun function_parameter =>
              let '(Eq, ctxt) := function_parameter in
              ok Eq ctxt 1)) (record_inconsistent ctxt ta tb)
      | (_, _) =>
        op_gtgtquestion (serialize_ty_for_error ctxt ta)
          (fun function_parameter =>
            let '(ta, ctxt) := function_parameter in
            op_gtgtquestion (serialize_ty_for_error ctxt tb)
              (fun function_parameter =>
                let '(tb, _ctxt) := function_parameter in
                __error_value
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.Inconsistent_types
                    ta tb)))
      end).

Fixpoint stack_ty_eq {ta tb : Set}
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context) (lvl : Z)
  (ta : Tezos_raw_protocol_alpha.Script_typed_ir.stack_ty ta)
  (tb : Tezos_raw_protocol_alpha.Script_typed_ir.stack_ty tb)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (eq (Tezos_raw_protocol_alpha.Script_typed_ir.stack_ty ta)
      (Tezos_raw_protocol_alpha.Script_typed_ir.stack_ty tb) *
      Tezos_raw_protocol_alpha.Alpha_context.context) :=
  match (ta, tb) with
  |
    (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t tva ra _,
      Tezos_raw_protocol_alpha.Script_typed_ir.Item_t tvb rb _) =>
    op_gtgtquestion
      (op_pipegt (ty_eq ctxt tva tvb)
        (record_trace
          (Tezos_protocol_environment_alpha__Environment.Error_monad.Bad_stack_item
            lvl)))
      (fun function_parameter =>
        let '(Eq, ctxt) := function_parameter in
        op_gtgtquestion (stack_ty_eq ctxt (op_plus lvl 1) ra rb)
          (fun function_parameter =>
            let '(Eq, ctxt) := function_parameter in
            Tezos_protocol_environment_alpha__Environment.Pervasives.Ok
              (Eq, ctxt)))
  |
    (Tezos_raw_protocol_alpha.Script_typed_ir.Empty_t,
      Tezos_raw_protocol_alpha.Script_typed_ir.Empty_t) =>
    Tezos_protocol_environment_alpha__Environment.Pervasives.Ok (Eq, ctxt)
  | (_, _) =>
    __error_value
      Tezos_protocol_environment_alpha__Environment.Error_monad.Bad_stack_length
  end.

Definition merge_comparable_types {ta : Set}
  (legacy : bool)
  (ta : Tezos_raw_protocol_alpha.Script_typed_ir.comparable_ty ta)
  (tb : Tezos_raw_protocol_alpha.Script_typed_ir.comparable_ty ta)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (Tezos_raw_protocol_alpha.Script_typed_ir.comparable_ty ta) :=
  match (ta, tb) with
  |
    (Tezos_raw_protocol_alpha.Script_typed_ir.Int_key annot_a,
      Tezos_raw_protocol_alpha.Script_typed_ir.Int_key annot_b) =>
    op_gtpipequestion (merge_type_annot legacy annot_a annot_b)
      (fun annot => Tezos_raw_protocol_alpha.Script_typed_ir.Int_key annot)
  |
    (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_key annot_a,
      Tezos_raw_protocol_alpha.Script_typed_ir.Nat_key annot_b) =>
    op_gtpipequestion (merge_type_annot legacy annot_a annot_b)
      (fun annot => Tezos_raw_protocol_alpha.Script_typed_ir.Nat_key annot)
  |
    (Tezos_raw_protocol_alpha.Script_typed_ir.String_key annot_a,
      Tezos_raw_protocol_alpha.Script_typed_ir.String_key annot_b) =>
    op_gtpipequestion (merge_type_annot legacy annot_a annot_b)
      (fun annot => Tezos_raw_protocol_alpha.Script_typed_ir.String_key annot)
  |
    (Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_key annot_a,
      Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_key annot_b) =>
    op_gtpipequestion (merge_type_annot legacy annot_a annot_b)
      (fun annot => Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_key annot)
  |
    (Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_key annot_a,
      Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_key annot_b) =>
    op_gtpipequestion (merge_type_annot legacy annot_a annot_b)
      (fun annot => Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_key annot)
  |
    (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_key annot_a,
      Tezos_raw_protocol_alpha.Script_typed_ir.Bool_key annot_b) =>
    op_gtpipequestion (merge_type_annot legacy annot_a annot_b)
      (fun annot => Tezos_raw_protocol_alpha.Script_typed_ir.Bool_key annot)
  |
    (Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_key annot_a,
      Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_key annot_b) =>
    op_gtpipequestion (merge_type_annot legacy annot_a annot_b)
      (fun annot => Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_key annot)
  |
    (Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_key annot_a,
      Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_key annot_b) =>
    op_gtpipequestion (merge_type_annot legacy annot_a annot_b)
      (fun annot => Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_key annot)
  |
    (Tezos_raw_protocol_alpha.Script_typed_ir.Address_key annot_a,
      Tezos_raw_protocol_alpha.Script_typed_ir.Address_key annot_b) =>
    op_gtpipequestion (merge_type_annot legacy annot_a annot_b)
      (fun annot => Tezos_raw_protocol_alpha.Script_typed_ir.Address_key annot)
  | (_, _) =>
    (* ❌ Assert instruction is not handled. *)
    assert false
  end.

Definition merge_types {b : Set} (legacy : bool)
  : Tezos_raw_protocol_alpha.Alpha_context.context ->
  Tezos_raw_protocol_alpha.Alpha_context.Script.location ->
  Tezos_raw_protocol_alpha.Script_typed_ir.ty b ->
  Tezos_raw_protocol_alpha.Script_typed_ir.ty b ->
  Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (Tezos_raw_protocol_alpha.Script_typed_ir.ty b *
      Tezos_raw_protocol_alpha.Alpha_context.context) :=
  let fix help {a : Set}
    (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context) (ty1 :
    Tezos_raw_protocol_alpha.Script_typed_ir.ty a) (ty2 :
    Tezos_raw_protocol_alpha.Script_typed_ir.ty a)
    : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Script_typed_ir.ty a *
        Tezos_raw_protocol_alpha.Alpha_context.context) :=
    match (ty1, ty2) with
    |
      (Tezos_raw_protocol_alpha.Script_typed_ir.Unit_t tn1,
        Tezos_raw_protocol_alpha.Script_typed_ir.Unit_t tn2) =>
      op_gtpipequestion (merge_type_annot legacy tn1 tn2)
        (fun tname =>
          ((Tezos_raw_protocol_alpha.Script_typed_ir.Unit_t tname), ctxt))
    |
      (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t tn1,
        Tezos_raw_protocol_alpha.Script_typed_ir.Int_t tn2) =>
      op_gtpipequestion (merge_type_annot legacy tn1 tn2)
        (fun tname =>
          ((Tezos_raw_protocol_alpha.Script_typed_ir.Int_t tname), ctxt))
    |
      (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t tn1,
        Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t tn2) =>
      op_gtpipequestion (merge_type_annot legacy tn1 tn2)
        (fun tname =>
          ((Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t tname), ctxt))
    |
      (Tezos_raw_protocol_alpha.Script_typed_ir.Key_t tn1,
        Tezos_raw_protocol_alpha.Script_typed_ir.Key_t tn2) =>
      op_gtpipequestion (merge_type_annot legacy tn1 tn2)
        (fun tname =>
          ((Tezos_raw_protocol_alpha.Script_typed_ir.Key_t tname), ctxt))
    |
      (Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_t tn1,
        Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_t tn2) =>
      op_gtpipequestion (merge_type_annot legacy tn1 tn2)
        (fun tname =>
          ((Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_t tname), ctxt))
    |
      (Tezos_raw_protocol_alpha.Script_typed_ir.String_t tn1,
        Tezos_raw_protocol_alpha.Script_typed_ir.String_t tn2) =>
      op_gtpipequestion (merge_type_annot legacy tn1 tn2)
        (fun tname =>
          ((Tezos_raw_protocol_alpha.Script_typed_ir.String_t tname), ctxt))
    |
      (Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_t tn1,
        Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_t tn2) =>
      op_gtpipequestion (merge_type_annot legacy tn1 tn2)
        (fun tname =>
          ((Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_t tname), ctxt))
    |
      (Tezos_raw_protocol_alpha.Script_typed_ir.Signature_t tn1,
        Tezos_raw_protocol_alpha.Script_typed_ir.Signature_t tn2) =>
      op_gtpipequestion (merge_type_annot legacy tn1 tn2)
        (fun tname =>
          ((Tezos_raw_protocol_alpha.Script_typed_ir.Signature_t tname), ctxt))
    |
      (Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_t tn1,
        Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_t tn2) =>
      op_gtpipequestion (merge_type_annot legacy tn1 tn2)
        (fun tname =>
          ((Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_t tname), ctxt))
    |
      (Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_t tn1,
        Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_t tn2) =>
      op_gtpipequestion (merge_type_annot legacy tn1 tn2)
        (fun tname =>
          ((Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_t tname), ctxt))
    |
      (Tezos_raw_protocol_alpha.Script_typed_ir.Address_t tn1,
        Tezos_raw_protocol_alpha.Script_typed_ir.Address_t tn2) =>
      op_gtpipequestion (merge_type_annot legacy tn1 tn2)
        (fun tname =>
          ((Tezos_raw_protocol_alpha.Script_typed_ir.Address_t tname), ctxt))
    |
      (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t tn1,
        Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t tn2) =>
      op_gtpipequestion (merge_type_annot legacy tn1 tn2)
        (fun tname =>
          ((Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t tname), ctxt))
    |
      (Tezos_raw_protocol_alpha.Script_typed_ir.Chain_id_t tn1,
        Tezos_raw_protocol_alpha.Script_typed_ir.Chain_id_t tn2) =>
      op_gtpipequestion (merge_type_annot legacy tn1 tn2)
        (fun tname =>
          ((Tezos_raw_protocol_alpha.Script_typed_ir.Chain_id_t tname), ctxt))
    |
      (Tezos_raw_protocol_alpha.Script_typed_ir.Operation_t tn1,
        Tezos_raw_protocol_alpha.Script_typed_ir.Operation_t tn2) =>
      op_gtpipequestion (merge_type_annot legacy tn1 tn2)
        (fun tname =>
          ((Tezos_raw_protocol_alpha.Script_typed_ir.Operation_t tname), ctxt))
    |
      (Tezos_raw_protocol_alpha.Script_typed_ir.Map_t tal tar tn1 has_big_map,
        Tezos_raw_protocol_alpha.Script_typed_ir.Map_t tbl tbr tn2 _) =>
      op_gtgtquestion (merge_type_annot legacy tn1 tn2)
        (fun tname =>
          op_gtgtquestion (help ctxt tar tbr)
            (fun function_parameter =>
              let '(value, ctxt) := function_parameter in
              op_gtgtquestion (ty_eq ctxt tar value)
                (fun function_parameter =>
                  let '(Eq, ctxt) := function_parameter in
                  op_gtpipequestion (merge_comparable_types legacy tal tbl)
                    (fun tk =>
                      ((Tezos_raw_protocol_alpha.Script_typed_ir.Map_t tk value
                        tname has_big_map), ctxt)))))
    |
      (Tezos_raw_protocol_alpha.Script_typed_ir.Big_map_t tal tar tn1,
        Tezos_raw_protocol_alpha.Script_typed_ir.Big_map_t tbl tbr tn2) =>
      op_gtgtquestion (merge_type_annot legacy tn1 tn2)
        (fun tname =>
          op_gtgtquestion (help ctxt tar tbr)
            (fun function_parameter =>
              let '(value, ctxt) := function_parameter in
              op_gtgtquestion (ty_eq ctxt tar value)
                (fun function_parameter =>
                  let '(Eq, ctxt) := function_parameter in
                  op_gtpipequestion (merge_comparable_types legacy tal tbl)
                    (fun tk =>
                      ((Tezos_raw_protocol_alpha.Script_typed_ir.Big_map_t tk
                        value tname), ctxt)))))
    |
      (Tezos_raw_protocol_alpha.Script_typed_ir.Set_t ea tn1,
        Tezos_raw_protocol_alpha.Script_typed_ir.Set_t eb tn2) =>
      op_gtgtquestion (merge_type_annot legacy tn1 tn2)
        (fun tname =>
          op_gtpipequestion (merge_comparable_types legacy ea eb)
            (fun e =>
              ((Tezos_raw_protocol_alpha.Script_typed_ir.Set_t e tname), ctxt)))
    |
      (Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t (tal, l_field1, l_var1)
        (tar, r_field1, r_var1) tn1 has_big_map,
        Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t (tbl, l_field2, l_var2)
          (tbr, r_field2, r_var2) tn2 _) =>
      op_gtgtquestion (merge_type_annot legacy tn1 tn2)
        (fun tname =>
          op_gtgtquestion (merge_field_annot legacy l_field1 l_field2)
            (fun l_field =>
              op_gtgtquestion (merge_field_annot legacy r_field1 r_field2)
                (fun r_field =>
                  let l_var := merge_var_annot l_var1 l_var2 in
                  let r_var := merge_var_annot r_var1 r_var2 in
                  op_gtgtquestion (help ctxt tal tbl)
                    (fun function_parameter =>
                      let '(left_ty, ctxt) := function_parameter in
                      op_gtpipequestion (help ctxt tar tbr)
                        (fun function_parameter =>
                          let '(right_ty, ctxt) := function_parameter in
                          ((Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t
                            (left_ty, l_field, l_var) (right_ty, r_field, r_var)
                            tname has_big_map), ctxt))))))
    |
      (Tezos_raw_protocol_alpha.Script_typed_ir.Union_t (tal, tal_annot)
        (tar, tar_annot) tn1 has_big_map,
        Tezos_raw_protocol_alpha.Script_typed_ir.Union_t (tbl, tbl_annot)
          (tbr, tbr_annot) tn2 _) =>
      op_gtgtquestion (merge_type_annot legacy tn1 tn2)
        (fun tname =>
          op_gtgtquestion (merge_field_annot legacy tal_annot tbl_annot)
            (fun left_annot =>
              op_gtgtquestion (merge_field_annot legacy tar_annot tbr_annot)
                (fun right_annot =>
                  op_gtgtquestion (help ctxt tal tbl)
                    (fun function_parameter =>
                      let '(left_ty, ctxt) := function_parameter in
                      op_gtpipequestion (help ctxt tar tbr)
                        (fun function_parameter =>
                          let '(right_ty, ctxt) := function_parameter in
                          ((Tezos_raw_protocol_alpha.Script_typed_ir.Union_t
                            (left_ty, left_annot) (right_ty, right_annot) tname
                            has_big_map), ctxt))))))
    |
      (Tezos_raw_protocol_alpha.Script_typed_ir.Lambda_t tal tar tn1,
        Tezos_raw_protocol_alpha.Script_typed_ir.Lambda_t tbl tbr tn2) =>
      op_gtgtquestion (merge_type_annot legacy tn1 tn2)
        (fun tname =>
          op_gtgtquestion (help ctxt tal tbl)
            (fun function_parameter =>
              let '(left_ty, ctxt) := function_parameter in
              op_gtpipequestion (help ctxt tar tbr)
                (fun function_parameter =>
                  let '(right_ty, ctxt) := function_parameter in
                  ((Tezos_raw_protocol_alpha.Script_typed_ir.Lambda_t left_ty
                    right_ty tname), ctxt))))
    |
      (Tezos_raw_protocol_alpha.Script_typed_ir.Contract_t tal tn1,
        Tezos_raw_protocol_alpha.Script_typed_ir.Contract_t tbl tn2) =>
      op_gtgtquestion (merge_type_annot legacy tn1 tn2)
        (fun tname =>
          op_gtpipequestion (help ctxt tal tbl)
            (fun function_parameter =>
              let '(arg_ty, ctxt) := function_parameter in
              ((Tezos_raw_protocol_alpha.Script_typed_ir.Contract_t arg_ty tname),
                ctxt)))
    |
      (Tezos_raw_protocol_alpha.Script_typed_ir.Option_t tva tn1 has_big_map,
        Tezos_raw_protocol_alpha.Script_typed_ir.Option_t tvb tn2 _) =>
      op_gtgtquestion (merge_type_annot legacy tn1 tn2)
        (fun tname =>
          op_gtpipequestion (help ctxt tva tvb)
            (fun function_parameter =>
              let '(ty, ctxt) := function_parameter in
              ((Tezos_raw_protocol_alpha.Script_typed_ir.Option_t ty tname
                has_big_map), ctxt)))
    |
      (Tezos_raw_protocol_alpha.Script_typed_ir.List_t tva tn1 has_big_map,
        Tezos_raw_protocol_alpha.Script_typed_ir.List_t tvb tn2 _) =>
      op_gtgtquestion (merge_type_annot legacy tn1 tn2)
        (fun tname =>
          op_gtpipequestion (help ctxt tva tvb)
            (fun function_parameter =>
              let '(ty, ctxt) := function_parameter in
              ((Tezos_raw_protocol_alpha.Script_typed_ir.List_t ty tname
                has_big_map), ctxt)))
    | (_, _) =>
      (* ❌ Assert instruction is not handled. *)
      assert false
    end in
  fun ctxt =>
    fun loc =>
      fun ty1 =>
        fun ty2 =>
          record_inconsistent_type_annotations ctxt loc ty1 ty2
            (help ctxt ty1 ty2).

Definition merge_stacks {ta : Set}
  (legacy : bool) (loc : Tezos_raw_protocol_alpha.Alpha_context.Script.location)
  : Tezos_raw_protocol_alpha.Alpha_context.context ->
  Tezos_raw_protocol_alpha.Script_typed_ir.stack_ty ta ->
  Tezos_raw_protocol_alpha.Script_typed_ir.stack_ty ta ->
  Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (Tezos_raw_protocol_alpha.Script_typed_ir.stack_ty ta *
      Tezos_raw_protocol_alpha.Alpha_context.context) :=
  let fix help {a : Set}
    (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context) (stack1 :
    Tezos_raw_protocol_alpha.Script_typed_ir.stack_ty a) (stack2 :
    Tezos_raw_protocol_alpha.Script_typed_ir.stack_ty a)
    : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Script_typed_ir.stack_ty a *
        Tezos_raw_protocol_alpha.Alpha_context.context) :=
    match (stack1, stack2) with
    |
      (Tezos_raw_protocol_alpha.Script_typed_ir.Empty_t,
        Tezos_raw_protocol_alpha.Script_typed_ir.Empty_t) =>
      ok (Tezos_raw_protocol_alpha.Script_typed_ir.Empty_t, ctxt)
    |
      (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t ty1 rest1 annot1,
        Tezos_raw_protocol_alpha.Script_typed_ir.Item_t ty2 rest2 annot2) =>
      let annot := merge_var_annot annot1 annot2 in
      op_gtgtquestion (merge_types legacy ctxt loc ty1 ty2)
        (fun function_parameter =>
          let '(ty, ctxt) := function_parameter in
          op_gtpipequestion (help ctxt rest1 rest2)
            (fun function_parameter =>
              let '(rest, ctxt) := function_parameter in
              ((Tezos_raw_protocol_alpha.Script_typed_ir.Item_t ty rest annot),
                ctxt)))
    end in
  help.

Definition has_big_map {t : Set}
  (function_parameter : Tezos_raw_protocol_alpha.Script_typed_ir.ty t) : bool :=
  match function_parameter with
  | Tezos_raw_protocol_alpha.Script_typed_ir.Unit_t _ => false
  | Tezos_raw_protocol_alpha.Script_typed_ir.Int_t _ => false
  | Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t _ => false
  | Tezos_raw_protocol_alpha.Script_typed_ir.Signature_t _ => false
  | Tezos_raw_protocol_alpha.Script_typed_ir.String_t _ => false
  | Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_t _ => false
  | Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_t _ => false
  | Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_t _ => false
  | Tezos_raw_protocol_alpha.Script_typed_ir.Key_t _ => false
  | Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_t _ => false
  | Tezos_raw_protocol_alpha.Script_typed_ir.Address_t _ => false
  | Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t _ => false
  | Tezos_raw_protocol_alpha.Script_typed_ir.Lambda_t _ _ _ => false
  | Tezos_raw_protocol_alpha.Script_typed_ir.Set_t _ _ => false
  | Tezos_raw_protocol_alpha.Script_typed_ir.Big_map_t _ _ _ => true
  | Tezos_raw_protocol_alpha.Script_typed_ir.Contract_t _ _ => false
  | Tezos_raw_protocol_alpha.Script_typed_ir.Operation_t _ => false
  | Tezos_raw_protocol_alpha.Script_typed_ir.Chain_id_t _ => false
  | Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t _ _ _ has_big_map =>
    has_big_map
  | Tezos_raw_protocol_alpha.Script_typed_ir.Union_t _ _ _ has_big_map =>
    has_big_map
  | Tezos_raw_protocol_alpha.Script_typed_ir.Option_t _ _ has_big_map =>
    has_big_map
  | Tezos_raw_protocol_alpha.Script_typed_ir.List_t _ _ has_big_map =>
    has_big_map
  | Tezos_raw_protocol_alpha.Script_typed_ir.Map_t _ _ _ has_big_map =>
    has_big_map
  end.

Reserved Notation "'judgement".

Inductive judgement_gadt : Set :=
| Typed : forall {aft bef : Set},
  Tezos_raw_protocol_alpha.Script_typed_ir.descr bef aft -> judgement_gadt
| Failed : forall {aft bef : Set},
  (Tezos_raw_protocol_alpha.Script_typed_ir.stack_ty aft ->
  Tezos_raw_protocol_alpha.Script_typed_ir.descr bef aft) * aft ->
  judgement_gadt

where "'judgement" := (fun (bef : Set) => judgement_gadt).

Definition judgement := 'judgement.

Module branch.
  Record record {t f b : Set} := {
    branch :
      (Tezos_raw_protocol_alpha.Script_typed_ir.descr t r ->
      Tezos_raw_protocol_alpha.Script_typed_ir.descr f r ->
      Tezos_raw_protocol_alpha.Script_typed_ir.descr b r) * r }.
  Arguments record : clear implicits.
End branch.
Definition branch := branch.record.

Definition merge_branches {a b bef : Set}
  (legacy : bool) (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
  (loc : Z) (btr : judgement a) (bfr : judgement b)
  (function_parameter : branch a b bef)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (judgement bef * Tezos_raw_protocol_alpha.Alpha_context.context)) :=
  let '{| branch.branch := branch |} := function_parameter in
  match (btr, bfr) with
  |
    (Typed
      ({| Tezos_raw_protocol_alpha.Script_typed_ir.descr.aft := aftbt |} as dbt),
      Typed
        ({| Tezos_raw_protocol_alpha.Script_typed_ir.descr.aft := aftbf |} as
          dbf)) =>
    let unmatched_branches (function_parameter : unit)
      : Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_protocol_environment_alpha__Environment.Error_monad.__error) :=
      let 'tt := function_parameter in
      op_gtgteqquestion (serialize_stack_for_error ctxt aftbt)
        (fun function_parameter =>
          let '(aftbt, ctxt) := function_parameter in
          op_gtgtpipequestion (serialize_stack_for_error ctxt aftbf)
            (fun function_parameter =>
              let '(aftbf, _ctxt) := function_parameter in
              Tezos_protocol_environment_alpha__Environment.Error_monad.Unmatched_branches
                loc aftbt aftbf)) in
    trace_eval unmatched_branches
      (op_gtgteqquestion (Lwt.__return (stack_ty_eq ctxt 1 aftbt aftbf))
        (fun function_parameter =>
          let '(Eq, ctxt) := function_parameter in
          op_gtgteqquestion
            (Lwt.__return (merge_stacks legacy loc ctxt aftbt aftbf))
            (fun function_parameter =>
              let '(merged_stack, ctxt) := function_parameter in
              __return
                ((Typed
                  (branch
                    (* ❌ Record substitution not handled *)
                    record_substitution
                    (* ❌ Record substitution not handled *)
                    record_substitution)), ctxt))))
  |
    (Failed {| judgement.Failed.descr := descrt |},
      Failed {| judgement.Failed.descr := descrf |}) =>
    let __descr_value {D : Set}
      (ret : Tezos_raw_protocol_alpha.Script_typed_ir.stack_ty D)
      : Tezos_raw_protocol_alpha.Script_typed_ir.descr bef D :=
      branch (descrt ret) (descrf ret) in
    __return ((Failed {| judgement.Failed.descr := __descr_value |}), ctxt)
  | (Typed dbt, Failed {| judgement.Failed.descr := descrf |}) =>
    __return
      ((Typed
        (branch dbt
          (descrf (Tezos_raw_protocol_alpha.Script_typed_ir.descr.aft dbt)))),
        ctxt)
  | (Failed {| judgement.Failed.descr := descrt |}, Typed dbf) =>
    __return
      ((Typed
        (branch
          (descrt (Tezos_raw_protocol_alpha.Script_typed_ir.descr.aft dbf)) dbf)),
        ctxt)
  end.

Fixpoint parse_comparable_ty
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
  (ty : Tezos_raw_protocol_alpha.Alpha_context.Script.node)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (ex_comparable_ty * Tezos_raw_protocol_alpha.Alpha_context.context) :=
  op_gtgtquestion (Gas.consume ctxt Typecheck_costs.cycle)
    (fun ctxt =>
      op_gtgtquestion (Gas.consume ctxt (Typecheck_costs.type_ 0))
        (fun ctxt =>
          match ty with
          |
            Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
              Tezos_raw_protocol_alpha.Alpha_context.Script.T_int [] annot =>
            op_gtpipequestion (parse_type_annot loc annot)
              (fun tname =>
                ((Ex_comparable_ty
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Int_key tname)),
                  ctxt))
          |
            Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
              Tezos_raw_protocol_alpha.Alpha_context.Script.T_nat [] annot =>
            op_gtpipequestion (parse_type_annot loc annot)
              (fun tname =>
                ((Ex_comparable_ty
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_key tname)),
                  ctxt))
          |
            Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
              Tezos_raw_protocol_alpha.Alpha_context.Script.T_string [] annot =>
            op_gtpipequestion (parse_type_annot loc annot)
              (fun tname =>
                ((Ex_comparable_ty
                  (Tezos_raw_protocol_alpha.Script_typed_ir.String_key tname)),
                  ctxt))
          |
            Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
              Tezos_raw_protocol_alpha.Alpha_context.Script.T_bytes [] annot =>
            op_gtpipequestion (parse_type_annot loc annot)
              (fun tname =>
                ((Ex_comparable_ty
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_key tname)),
                  ctxt))
          |
            Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
              Tezos_raw_protocol_alpha.Alpha_context.Script.T_mutez [] annot =>
            op_gtpipequestion (parse_type_annot loc annot)
              (fun tname =>
                ((Ex_comparable_ty
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_key tname)),
                  ctxt))
          |
            Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
              Tezos_raw_protocol_alpha.Alpha_context.Script.T_bool [] annot =>
            op_gtpipequestion (parse_type_annot loc annot)
              (fun tname =>
                ((Ex_comparable_ty
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_key tname)),
                  ctxt))
          |
            Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
              Tezos_raw_protocol_alpha.Alpha_context.Script.T_key_hash [] annot
            =>
            op_gtpipequestion (parse_type_annot loc annot)
              (fun tname =>
                ((Ex_comparable_ty
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_key tname)),
                  ctxt))
          |
            Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
              Tezos_raw_protocol_alpha.Alpha_context.Script.T_timestamp [] annot
            =>
            op_gtpipequestion (parse_type_annot loc annot)
              (fun tname =>
                ((Ex_comparable_ty
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_key tname)),
                  ctxt))
          |
            Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
              Tezos_raw_protocol_alpha.Alpha_context.Script.T_address [] annot
            =>
            op_gtpipequestion (parse_type_annot loc annot)
              (fun tname =>
                ((Ex_comparable_ty
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Address_key tname)),
                  ctxt))
          |
            Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
              ((Tezos_raw_protocol_alpha.Alpha_context.Script.T_int |
                Tezos_raw_protocol_alpha.Alpha_context.Script.T_nat |
                Tezos_raw_protocol_alpha.Alpha_context.Script.T_string |
                Tezos_raw_protocol_alpha.Alpha_context.Script.T_mutez |
                Tezos_raw_protocol_alpha.Alpha_context.Script.T_bool |
                Tezos_raw_protocol_alpha.Alpha_context.Script.T_key |
                Tezos_raw_protocol_alpha.Alpha_context.Script.T_address |
                Tezos_raw_protocol_alpha.Alpha_context.Script.T_timestamp) as
                prim) l _ =>
            __error_value
              (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_arity
                loc prim 0 (List.length l))
          |
            Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
              (Tezos_raw_protocol_alpha.Alpha_context.Script.T_pair |
                Tezos_raw_protocol_alpha.Alpha_context.Script.T_or |
                Tezos_raw_protocol_alpha.Alpha_context.Script.T_set |
                Tezos_raw_protocol_alpha.Alpha_context.Script.T_map |
                Tezos_raw_protocol_alpha.Alpha_context.Script.T_list |
                Tezos_raw_protocol_alpha.Alpha_context.Script.T_option |
                Tezos_raw_protocol_alpha.Alpha_context.Script.T_lambda |
                Tezos_raw_protocol_alpha.Alpha_context.Script.T_unit |
                Tezos_raw_protocol_alpha.Alpha_context.Script.T_signature |
                Tezos_raw_protocol_alpha.Alpha_context.Script.T_contract) _ _ =>
            __error_value
              (Tezos_protocol_environment_alpha__Environment.Error_monad.Comparable_type_expected
                loc (Micheline.strip_locations ty))
          | expr =>
            op_atat __error_value
              (unexpected expr []
                Tezos_raw_protocol_alpha.Script_tc_errors.Type_namespace
                (cons Tezos_raw_protocol_alpha.Alpha_context.Script.T_int
                  (cons Tezos_raw_protocol_alpha.Alpha_context.Script.T_nat
                    (cons Tezos_raw_protocol_alpha.Alpha_context.Script.T_string
                      (cons
                        Tezos_raw_protocol_alpha.Alpha_context.Script.T_mutez
                        (cons
                          Tezos_raw_protocol_alpha.Alpha_context.Script.T_bool
                          (cons
                            Tezos_raw_protocol_alpha.Alpha_context.Script.T_key
                            (cons
                              Tezos_raw_protocol_alpha.Alpha_context.Script.T_key_hash
                              (cons
                                Tezos_raw_protocol_alpha.Alpha_context.Script.T_timestamp
                                [])))))))))
          end))

with parse_packable_ty
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context) (legacy : bool)
  : Tezos_raw_protocol_alpha.Alpha_context.Script.node ->
  Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (ex_ty * Tezos_raw_protocol_alpha.Alpha_context.context) :=
  parse_ty ctxt legacy false false legacy

with parse_parameter_ty
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context) (legacy : bool)
  : Tezos_raw_protocol_alpha.Alpha_context.Script.node ->
  Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (ex_ty * Tezos_raw_protocol_alpha.Alpha_context.context) :=
  parse_ty ctxt legacy true false true

with parse_any_ty
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context) (legacy : bool)
  : Tezos_raw_protocol_alpha.Alpha_context.Script.node ->
  Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (ex_ty * Tezos_raw_protocol_alpha.Alpha_context.context) :=
  parse_ty ctxt legacy true true true

with parse_ty
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context) (legacy : bool)
  (allow_big_map : bool) (allow_operation : bool) (allow_contract : bool)
  (node : Tezos_raw_protocol_alpha.Alpha_context.Script.node)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (ex_ty * Tezos_raw_protocol_alpha.Alpha_context.context) :=
  op_gtgtquestion (Gas.consume ctxt Typecheck_costs.cycle)
    (fun ctxt =>
      match node with
      |
        Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.T_unit [] annot =>
        op_gtgtquestion (parse_type_annot loc annot)
          (fun ty_name =>
            op_gtpipequestion (Gas.consume ctxt (Typecheck_costs.type_ 0))
              (fun ctxt =>
                ((Ex_ty
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Unit_t ty_name)),
                  ctxt)))
      |
        Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.T_int [] annot =>
        op_gtgtquestion (parse_type_annot loc annot)
          (fun ty_name =>
            op_gtpipequestion (Gas.consume ctxt (Typecheck_costs.type_ 0))
              (fun ctxt =>
                ((Ex_ty (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t ty_name)),
                  ctxt)))
      |
        Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.T_nat [] annot =>
        op_gtgtquestion (parse_type_annot loc annot)
          (fun ty_name =>
            op_gtpipequestion (Gas.consume ctxt (Typecheck_costs.type_ 0))
              (fun ctxt =>
                ((Ex_ty (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t ty_name)),
                  ctxt)))
      |
        Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.T_string [] annot =>
        op_gtgtquestion (parse_type_annot loc annot)
          (fun ty_name =>
            op_gtpipequestion (Gas.consume ctxt (Typecheck_costs.type_ 0))
              (fun ctxt =>
                ((Ex_ty
                  (Tezos_raw_protocol_alpha.Script_typed_ir.String_t ty_name)),
                  ctxt)))
      |
        Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.T_bytes [] annot =>
        op_gtgtquestion (parse_type_annot loc annot)
          (fun ty_name =>
            op_gtpipequestion (Gas.consume ctxt (Typecheck_costs.type_ 0))
              (fun ctxt =>
                ((Ex_ty
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_t ty_name)),
                  ctxt)))
      |
        Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.T_mutez [] annot =>
        op_gtgtquestion (parse_type_annot loc annot)
          (fun ty_name =>
            op_gtpipequestion (Gas.consume ctxt (Typecheck_costs.type_ 0))
              (fun ctxt =>
                ((Ex_ty
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_t ty_name)),
                  ctxt)))
      |
        Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.T_bool [] annot =>
        op_gtgtquestion (parse_type_annot loc annot)
          (fun ty_name =>
            op_gtpipequestion (Gas.consume ctxt (Typecheck_costs.type_ 0))
              (fun ctxt =>
                ((Ex_ty
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t ty_name)),
                  ctxt)))
      |
        Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.T_key [] annot =>
        op_gtgtquestion (parse_type_annot loc annot)
          (fun ty_name =>
            op_gtpipequestion (Gas.consume ctxt (Typecheck_costs.type_ 0))
              (fun ctxt =>
                ((Ex_ty (Tezos_raw_protocol_alpha.Script_typed_ir.Key_t ty_name)),
                  ctxt)))
      |
        Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.T_key_hash [] annot =>
        op_gtgtquestion (parse_type_annot loc annot)
          (fun ty_name =>
            op_gtpipequestion (Gas.consume ctxt (Typecheck_costs.type_ 0))
              (fun ctxt =>
                ((Ex_ty
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_t ty_name)),
                  ctxt)))
      |
        Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.T_timestamp [] annot =>
        op_gtgtquestion (parse_type_annot loc annot)
          (fun ty_name =>
            op_gtpipequestion (Gas.consume ctxt (Typecheck_costs.type_ 0))
              (fun ctxt =>
                ((Ex_ty
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_t ty_name)),
                  ctxt)))
      |
        Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.T_address [] annot =>
        op_gtgtquestion (parse_type_annot loc annot)
          (fun ty_name =>
            op_gtpipequestion (Gas.consume ctxt (Typecheck_costs.type_ 0))
              (fun ctxt =>
                ((Ex_ty
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Address_t ty_name)),
                  ctxt)))
      |
        Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.T_signature [] annot =>
        op_gtgtquestion (parse_type_annot loc annot)
          (fun ty_name =>
            op_gtpipequestion (Gas.consume ctxt (Typecheck_costs.type_ 0))
              (fun ctxt =>
                ((Ex_ty
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Signature_t ty_name)),
                  ctxt)))
      |
        Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.T_operation [] annot =>
        if allow_operation then
          op_gtgtquestion (parse_type_annot loc annot)
            (fun ty_name =>
              op_gtpipequestion (Gas.consume ctxt (Typecheck_costs.type_ 0))
                (fun ctxt =>
                  ((Ex_ty
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Operation_t
                      ty_name)), ctxt)))
        else
          __error_value
            (Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_operation
              loc)
      |
        Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.T_chain_id [] annot =>
        op_gtgtquestion (parse_type_annot loc annot)
          (fun ty_name =>
            op_gtpipequestion (Gas.consume ctxt (Typecheck_costs.type_ 0))
              (fun ctxt =>
                ((Ex_ty
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Chain_id_t ty_name)),
                  ctxt)))
      |
        Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.T_contract (cons utl [])
          annot =>
        if allow_contract then
          op_gtgtquestion (parse_parameter_ty ctxt legacy utl)
            (fun function_parameter =>
              let '(Ex_ty tl, ctxt) := function_parameter in
              op_gtgtquestion (parse_type_annot loc annot)
                (fun ty_name =>
                  op_gtpipequestion (Gas.consume ctxt (Typecheck_costs.type_ 1))
                    (fun ctxt =>
                      ((Ex_ty
                        (Tezos_raw_protocol_alpha.Script_typed_ir.Contract_t tl
                          ty_name)), ctxt))))
        else
          __error_value
            (Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_contract
              loc)
      |
        Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.T_pair
          (cons utl (cons utr [])) annot =>
        op_gtgtquestion (extract_field_annot utl)
          (fun function_parameter =>
            let '(utl, left_field) := function_parameter in
            op_gtgtquestion (extract_field_annot utr)
              (fun function_parameter =>
                let '(utr, right_field) := function_parameter in
                op_gtgtquestion
                  (parse_ty ctxt legacy allow_big_map allow_operation
                    allow_contract utl)
                  (fun function_parameter =>
                    let '(Ex_ty tl, ctxt) := function_parameter in
                    op_gtgtquestion
                      (parse_ty ctxt legacy allow_big_map allow_operation
                        allow_contract utr)
                      (fun function_parameter =>
                        let '(Ex_ty tr, ctxt) := function_parameter in
                        op_gtgtquestion (parse_type_annot loc annot)
                          (fun ty_name =>
                            op_gtpipequestion
                              (Gas.consume ctxt (Typecheck_costs.type_ 2))
                              (fun ctxt =>
                                ((Ex_ty
                                  (Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t
                                    (tl, left_field, None)
                                    (tr, right_field, None) ty_name
                                    (op_pipepipe (has_big_map tl)
                                      (has_big_map tr)))), ctxt)))))))
      |
        Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.T_or
          (cons utl (cons utr [])) annot =>
        op_gtgtquestion (extract_field_annot utl)
          (fun function_parameter =>
            let '(utl, left_constr) := function_parameter in
            op_gtgtquestion (extract_field_annot utr)
              (fun function_parameter =>
                let '(utr, right_constr) := function_parameter in
                op_gtgtquestion
                  (parse_ty ctxt legacy allow_big_map allow_operation
                    allow_contract utl)
                  (fun function_parameter =>
                    let '(Ex_ty tl, ctxt) := function_parameter in
                    op_gtgtquestion
                      (parse_ty ctxt legacy allow_big_map allow_operation
                        allow_contract utr)
                      (fun function_parameter =>
                        let '(Ex_ty tr, ctxt) := function_parameter in
                        op_gtgtquestion (parse_type_annot loc annot)
                          (fun ty_name =>
                            op_gtpipequestion
                              (Gas.consume ctxt (Typecheck_costs.type_ 2))
                              (fun ctxt =>
                                ((Ex_ty
                                  (Tezos_raw_protocol_alpha.Script_typed_ir.Union_t
                                    (tl, left_constr) (tr, right_constr) ty_name
                                    (op_pipepipe (has_big_map tl)
                                      (has_big_map tr)))), ctxt)))))))
      |
        Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.T_lambda
          (cons uta (cons utr [])) annot =>
        op_gtgtquestion (parse_any_ty ctxt legacy uta)
          (fun function_parameter =>
            let '(Ex_ty ta, ctxt) := function_parameter in
            op_gtgtquestion (parse_any_ty ctxt legacy utr)
              (fun function_parameter =>
                let '(Ex_ty tr, ctxt) := function_parameter in
                op_gtgtquestion (parse_type_annot loc annot)
                  (fun ty_name =>
                    op_gtpipequestion
                      (Gas.consume ctxt (Typecheck_costs.type_ 2))
                      (fun ctxt =>
                        ((Ex_ty
                          (Tezos_raw_protocol_alpha.Script_typed_ir.Lambda_t ta
                            tr ty_name)), ctxt)))))
      |
        Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.T_option (cons ut [])
          annot =>
        op_gtgtquestion
          (if legacy then
            op_gtgtquestion (extract_field_annot ut)
              (fun function_parameter =>
                let '(ut, _some_constr) := function_parameter in
                op_gtgtquestion (parse_composed_type_annot loc annot)
                  (fun function_parameter =>
                    let '(ty_name, _none_constr, _) := function_parameter in
                    ok (ut, ty_name)))
          else
            op_gtgtquestion (parse_type_annot loc annot)
              (fun ty_name => ok (ut, ty_name)))
          (fun function_parameter =>
            let '(ut, ty_name) := function_parameter in
            op_gtgtquestion
              (parse_ty ctxt legacy allow_big_map allow_operation allow_contract
                ut)
              (fun function_parameter =>
                let '(Ex_ty t, ctxt) := function_parameter in
                op_gtpipequestion (Gas.consume ctxt (Typecheck_costs.type_ 2))
                  (fun ctxt =>
                    ((Ex_ty
                      (Tezos_raw_protocol_alpha.Script_typed_ir.Option_t t
                        ty_name (has_big_map t))), ctxt))))
      |
        Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.T_list (cons ut [])
          annot =>
        op_gtgtquestion
          (parse_ty ctxt legacy allow_big_map allow_operation allow_contract ut)
          (fun function_parameter =>
            let '(Ex_ty t, ctxt) := function_parameter in
            op_gtgtquestion (parse_type_annot loc annot)
              (fun ty_name =>
                op_gtpipequestion (Gas.consume ctxt (Typecheck_costs.type_ 1))
                  (fun ctxt =>
                    ((Ex_ty
                      (Tezos_raw_protocol_alpha.Script_typed_ir.List_t t ty_name
                        (has_big_map t))), ctxt))))
      |
        Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.T_set (cons ut []) annot
        =>
        op_gtgtquestion (parse_comparable_ty ctxt ut)
          (fun function_parameter =>
            let '(Ex_comparable_ty t, ctxt) := function_parameter in
            op_gtgtquestion (parse_type_annot loc annot)
              (fun ty_name =>
                op_gtpipequestion (Gas.consume ctxt (Typecheck_costs.type_ 1))
                  (fun ctxt =>
                    ((Ex_ty
                      (Tezos_raw_protocol_alpha.Script_typed_ir.Set_t t ty_name)),
                      ctxt))))
      |
        Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.T_map
          (cons uta (cons utr [])) annot =>
        op_gtgtquestion (parse_comparable_ty ctxt uta)
          (fun function_parameter =>
            let '(Ex_comparable_ty ta, ctxt) := function_parameter in
            op_gtgtquestion
              (parse_ty ctxt legacy allow_big_map allow_operation allow_contract
                utr)
              (fun function_parameter =>
                let '(Ex_ty tr, ctxt) := function_parameter in
                op_gtgtquestion (parse_type_annot loc annot)
                  (fun ty_name =>
                    op_gtpipequestion
                      (Gas.consume ctxt (Typecheck_costs.type_ 2))
                      (fun ctxt =>
                        ((Ex_ty
                          (Tezos_raw_protocol_alpha.Script_typed_ir.Map_t ta tr
                            ty_name (has_big_map tr))), ctxt)))))
      |
        Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.T_big_map args annot =>
        op_gtgtquestion (parse_big_map_ty ctxt legacy loc args annot)
          (fun function_parameter =>
            let '(big_map_ty, ctxt) := function_parameter in
            op_gtpipequestion (Gas.consume ctxt (Typecheck_costs.type_ 2))
              (fun ctxt => (big_map_ty, ctxt)))
      |
        Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.T_big_map _ _ =>
        __error_value
          (Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_big_map
            loc)
      |
        Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          ((Tezos_raw_protocol_alpha.Alpha_context.Script.T_unit |
            Tezos_raw_protocol_alpha.Alpha_context.Script.T_signature |
            Tezos_raw_protocol_alpha.Alpha_context.Script.T_int |
            Tezos_raw_protocol_alpha.Alpha_context.Script.T_nat |
            Tezos_raw_protocol_alpha.Alpha_context.Script.T_string |
            Tezos_raw_protocol_alpha.Alpha_context.Script.T_bytes |
            Tezos_raw_protocol_alpha.Alpha_context.Script.T_mutez |
            Tezos_raw_protocol_alpha.Alpha_context.Script.T_bool |
            Tezos_raw_protocol_alpha.Alpha_context.Script.T_key |
            Tezos_raw_protocol_alpha.Alpha_context.Script.T_key_hash |
            Tezos_raw_protocol_alpha.Alpha_context.Script.T_timestamp |
            Tezos_raw_protocol_alpha.Alpha_context.Script.T_address) as prim) l
          _ =>
        __error_value
          (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_arity
            loc prim 0 (List.length l))
      |
        Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          ((Tezos_raw_protocol_alpha.Alpha_context.Script.T_set |
            Tezos_raw_protocol_alpha.Alpha_context.Script.T_list |
            Tezos_raw_protocol_alpha.Alpha_context.Script.T_option |
            Tezos_raw_protocol_alpha.Alpha_context.Script.T_contract) as prim) l
          _ =>
        __error_value
          (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_arity
            loc prim 1 (List.length l))
      |
        Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          ((Tezos_raw_protocol_alpha.Alpha_context.Script.T_pair |
            Tezos_raw_protocol_alpha.Alpha_context.Script.T_or |
            Tezos_raw_protocol_alpha.Alpha_context.Script.T_map |
            Tezos_raw_protocol_alpha.Alpha_context.Script.T_lambda) as prim) l _
        =>
        __error_value
          (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_arity
            loc prim 2 (List.length l))
      | expr =>
        op_atat __error_value
          (unexpected expr []
            Tezos_raw_protocol_alpha.Script_tc_errors.Type_namespace
            (cons Tezos_raw_protocol_alpha.Alpha_context.Script.T_pair
              (cons Tezos_raw_protocol_alpha.Alpha_context.Script.T_or
                (cons Tezos_raw_protocol_alpha.Alpha_context.Script.T_set
                  (cons Tezos_raw_protocol_alpha.Alpha_context.Script.T_map
                    (cons Tezos_raw_protocol_alpha.Alpha_context.Script.T_list
                      (cons
                        Tezos_raw_protocol_alpha.Alpha_context.Script.T_option
                        (cons
                          Tezos_raw_protocol_alpha.Alpha_context.Script.T_lambda
                          (cons
                            Tezos_raw_protocol_alpha.Alpha_context.Script.T_unit
                            (cons
                              Tezos_raw_protocol_alpha.Alpha_context.Script.T_signature
                              (cons
                                Tezos_raw_protocol_alpha.Alpha_context.Script.T_contract
                                (cons
                                  Tezos_raw_protocol_alpha.Alpha_context.Script.T_int
                                  (cons
                                    Tezos_raw_protocol_alpha.Alpha_context.Script.T_nat
                                    (cons
                                      Tezos_raw_protocol_alpha.Alpha_context.Script.T_operation
                                      (cons
                                        Tezos_raw_protocol_alpha.Alpha_context.Script.T_string
                                        (cons
                                          Tezos_raw_protocol_alpha.Alpha_context.Script.T_bytes
                                          (cons
                                            Tezos_raw_protocol_alpha.Alpha_context.Script.T_mutez
                                            (cons
                                              Tezos_raw_protocol_alpha.Alpha_context.Script.T_bool
                                              (cons
                                                Tezos_raw_protocol_alpha.Alpha_context.Script.T_key
                                                (cons
                                                  Tezos_raw_protocol_alpha.Alpha_context.Script.T_key_hash
                                                  (cons
                                                    Tezos_raw_protocol_alpha.Alpha_context.Script.T_timestamp
                                                    (cons
                                                      Tezos_raw_protocol_alpha.Alpha_context.Script.T_chain_id
                                                      []))))))))))))))))))))))
      end)

with parse_big_map_ty
  (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context) (legacy : bool)
  (big_map_loc : Tezos_raw_protocol_alpha.Alpha_context.Script.location)
  (args :
    list
      (Tezos_protocol_environment_alpha__Environment.Micheline.node
        Tezos_raw_protocol_alpha.Alpha_context.Script.location
        Tezos_raw_protocol_alpha.Alpha_context.Script.prim))
  (map_annot : Tezos_protocol_environment_alpha__Environment.Micheline.annot)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (ex_ty * Tezos_raw_protocol_alpha__Alpha_context.context) :=
  op_gtgtquestion (Gas.consume ctxt Typecheck_costs.cycle)
    (fun ctxt =>
      match args with
      | cons key_ty (cons value_ty []) =>
        op_gtgtquestion (parse_comparable_ty ctxt key_ty)
          (fun function_parameter =>
            let '(Ex_comparable_ty key_ty, ctxt) := function_parameter in
            op_gtgtquestion (parse_packable_ty ctxt legacy value_ty)
              (fun function_parameter =>
                let '(Ex_ty value_ty, ctxt) := function_parameter in
                op_gtpipequestion (parse_type_annot big_map_loc map_annot)
                  (fun map_name =>
                    let big_map_ty :=
                      Tezos_raw_protocol_alpha.Script_typed_ir.Big_map_t key_ty
                        value_ty map_name in
                    ((Ex_ty big_map_ty), ctxt))))
      | args =>
        op_atat __error_value
          (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_arity
            big_map_loc Tezos_raw_protocol_alpha.Alpha_context.Script.T_big_map
            2 (List.length args))
      end)

with parse_storage_ty
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context) (legacy : bool)
  (node : Tezos_raw_protocol_alpha.Alpha_context.Script.node)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (ex_ty * Tezos_raw_protocol_alpha.Alpha_context.context) :=
  match node with
  |
    Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
      Tezos_raw_protocol_alpha.Alpha_context.Script.T_pair
      (cons
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
          big_map_loc Tezos_raw_protocol_alpha.Alpha_context.Script.T_big_map
          args map_annot) (cons remaining_storage [])) storage_annot =>
    match storage_annot with
    | [] => parse_ty ctxt legacy true false legacy node
    | cons single [] => parse_ty ctxt legacy true false legacy node
    | _ =>
      op_gtgtquestion (Gas.consume ctxt Typecheck_costs.cycle)
        (fun ctxt =>
          op_gtgtquestion
            (parse_big_map_ty ctxt legacy big_map_loc args map_annot)
            (fun function_parameter =>
              let '(Ex_ty big_map_ty, ctxt) := function_parameter in
              op_gtgtquestion
                (parse_ty ctxt legacy true false legacy remaining_storage)
                (fun function_parameter =>
                  let '(Ex_ty remaining_storage, ctxt) := function_parameter in
                  op_gtgtquestion (parse_composed_type_annot loc storage_annot)
                    (fun function_parameter =>
                      let '(ty_name, map_field, storage_field) :=
                        function_parameter in
                      op_gtpipequestion
                        (Gas.consume ctxt (Typecheck_costs.type_ 5))
                        (fun ctxt =>
                          ((Ex_ty
                            (Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t
                              (big_map_ty, map_field, None)
                              (remaining_storage, storage_field, None) ty_name
                              true)), ctxt))))))
    end
  | _ => parse_ty ctxt legacy true false legacy node
  end.

Definition check_packable {A : Set}
  (legacy : bool) (loc : Tezos_raw_protocol_alpha.Alpha_context.Script.location)
  (root : Tezos_raw_protocol_alpha.Script_typed_ir.ty A)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit :=
  let fix check {t : Set}
    (function_parameter : Tezos_raw_protocol_alpha.Script_typed_ir.ty t)
    : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit :=
    match function_parameter with
    | Tezos_raw_protocol_alpha.Script_typed_ir.Big_map_t _ _ _ =>
      __error_value
        (Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_big_map
          loc)
    | Tezos_raw_protocol_alpha.Script_typed_ir.Operation_t _ =>
      __error_value
        (Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_operation
          loc)
    | Tezos_raw_protocol_alpha.Script_typed_ir.Unit_t _ => ok tt
    | Tezos_raw_protocol_alpha.Script_typed_ir.Int_t _ => ok tt
    | Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t _ => ok tt
    | Tezos_raw_protocol_alpha.Script_typed_ir.Signature_t _ => ok tt
    | Tezos_raw_protocol_alpha.Script_typed_ir.String_t _ => ok tt
    | Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_t _ => ok tt
    | Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_t _ => ok tt
    | Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_t _ => ok tt
    | Tezos_raw_protocol_alpha.Script_typed_ir.Key_t _ => ok tt
    | Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_t _ => ok tt
    | Tezos_raw_protocol_alpha.Script_typed_ir.Address_t _ => ok tt
    | Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t _ => ok tt
    | Tezos_raw_protocol_alpha.Script_typed_ir.Chain_id_t _ => ok tt
    |
      Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t (l_ty, _, _) (r_ty, _, _)
        _ _ =>
      op_gtgtquestion (check l_ty)
        (fun function_parameter =>
          let 'tt := function_parameter in
          check r_ty)
    | Tezos_raw_protocol_alpha.Script_typed_ir.Union_t (l_ty, _) (r_ty, _) _ _
      =>
      op_gtgtquestion (check l_ty)
        (fun function_parameter =>
          let 'tt := function_parameter in
          check r_ty)
    | Tezos_raw_protocol_alpha.Script_typed_ir.Option_t v_ty _ _ => check v_ty
    | Tezos_raw_protocol_alpha.Script_typed_ir.List_t elt_ty _ _ => check elt_ty
    | Tezos_raw_protocol_alpha.Script_typed_ir.Set_t _ _ => ok tt
    | Tezos_raw_protocol_alpha.Script_typed_ir.Map_t _ elt_ty _ _ =>
      check elt_ty
    | Tezos_raw_protocol_alpha.Script_typed_ir.Lambda_t _l_ty _r_ty _ => ok tt
    | Tezos_raw_protocol_alpha.Script_typed_ir.Contract_t _ _ => ok tt
    | Tezos_raw_protocol_alpha.Script_typed_ir.Contract_t _ _ =>
      __error_value
        (Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_contract
          loc)
    end in
  check root.

Reserved Notation "'ex_script".

Inductive ex_script_gadt : Set :=
| Ex_script : forall {a c : Set},
  Tezos_raw_protocol_alpha.Script_typed_ir.script a c -> ex_script_gadt

where "'ex_script" := (ex_script_gadt).

Definition ex_script := 'ex_script.

Reserved Notation "'dig_proof_argument".

Inductive dig_proof_argument_gadt : Set :=
| Dig_proof_argument : forall {aft bef rest x : Set},
  Tezos_raw_protocol_alpha.Script_typed_ir.stack_prefix_preservation_witness
    (x * rest) rest bef aft *
    (Tezos_raw_protocol_alpha.Script_typed_ir.ty x *
      option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot) *
    Tezos_raw_protocol_alpha.Script_typed_ir.stack_ty aft ->
  dig_proof_argument_gadt

where "'dig_proof_argument" := (fun (_ : Set) => dig_proof_argument_gadt).

Definition dig_proof_argument := 'dig_proof_argument.

Reserved Notation "'dug_proof_argument".

Inductive dug_proof_argument_gadt : Set :=
| Dug_proof_argument : forall {aft bef rest x : Set},
  Tezos_raw_protocol_alpha.Script_typed_ir.stack_prefix_preservation_witness
    rest (x * rest) bef aft * unit *
    Tezos_raw_protocol_alpha.Script_typed_ir.stack_ty aft ->
  dug_proof_argument_gadt

where "'dug_proof_argument" := (fun (_ _ : Set) => dug_proof_argument_gadt).

Definition dug_proof_argument := 'dug_proof_argument.

Reserved Notation "'dipn_proof_argument".

Inductive dipn_proof_argument_gadt : Set :=
| Dipn_proof_argument : forall {aft bef faft fbef : Set},
  Tezos_raw_protocol_alpha.Script_typed_ir.stack_prefix_preservation_witness
    fbef faft bef aft *
    (Tezos_raw_protocol_alpha.Alpha_context.context *
      Tezos_raw_protocol_alpha.Script_typed_ir.descr fbef faft) *
    Tezos_raw_protocol_alpha.Script_typed_ir.stack_ty aft ->
  dipn_proof_argument_gadt

where "'dipn_proof_argument" := (fun (_ : Set) => dipn_proof_argument_gadt).

Definition dipn_proof_argument := 'dipn_proof_argument.

Reserved Notation "'dropn_proof_argument".

Inductive dropn_proof_argument_gadt : Set :=
| Dropn_proof_argument : forall {aft bef rest : Set},
  Tezos_raw_protocol_alpha.Script_typed_ir.stack_prefix_preservation_witness
    rest rest bef aft * Tezos_raw_protocol_alpha.Script_typed_ir.stack_ty rest *
    Tezos_raw_protocol_alpha.Script_typed_ir.stack_ty aft ->
  dropn_proof_argument_gadt

where "'dropn_proof_argument" := (fun (_ : Set) => dropn_proof_argument_gadt).

Definition dropn_proof_argument := 'dropn_proof_argument.

Definition parse_var_annot
  (loc : Z)
  (default : option (option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot))
  (annot : list string)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot)) :=
  Lwt.__return (parse_var_annot loc default annot).

Definition parse_entrypoint_annot
  (loc : Z)
  (default : option (option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot))
  (annot : list string)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot *
        option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot)) :=
  Lwt.__return (parse_entrypoint_annot loc default annot).

Definition parse_constr_annot
  (loc : Z)
  (if_special_first :
    option (option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot))
  (if_special_second :
    option (option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot))
  (annot : list string)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot *
        option Tezos_raw_protocol_alpha.Script_typed_ir.type_annot *
        option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot *
        option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot)) :=
  Lwt.__return (parse_constr_annot loc if_special_first if_special_second annot).

Definition parse_two_var_annot (loc : Z) (annot : list string)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot *
        option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot)) :=
  Lwt.__return (parse_two_var_annot loc annot).

Definition parse_destr_annot
  (loc : Z) (annot : list string)
  (default_accessor :
    option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot)
  (field_name : option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot)
  (pair_annot : option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot)
  (value_annot : option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot *
        option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot)) :=
  Lwt.__return
    (parse_destr_annot loc annot default_accessor field_name pair_annot
      value_annot).

Definition parse_var_type_annot (loc : Z) (annot : list string)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot *
        option Tezos_raw_protocol_alpha.Script_typed_ir.type_annot)) :=
  Lwt.__return (parse_var_type_annot loc annot).

Definition find_entrypoint {A : Set}
  (full : Tezos_raw_protocol_alpha.Script_typed_ir.ty A)
  (root_name :
    option Tezos_protocol_environment_alpha__Environment.Compare.String.t)
  (entrypoint : Tezos_protocol_environment_alpha__Environment.Compare.String.t)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    ((Tezos_raw_protocol_alpha.Alpha_context.Script.node ->
    Tezos_raw_protocol_alpha.Alpha_context.Script.node) * ex_ty) :=
  let fix find_entrypoint {t : Set}
    (t : Tezos_raw_protocol_alpha.Script_typed_ir.ty t) (entrypoint : string)
    : (Tezos_raw_protocol_alpha.Alpha_context.Script.node ->
    Tezos_raw_protocol_alpha.Alpha_context.Script.node) * ex_ty :=
    match t with
    | Tezos_raw_protocol_alpha.Script_typed_ir.Union_t (tl, al) (tr, ar) _ _ =>
      if
        match al with
        | None => false
        | Some (Field_annot l) => op_eq l entrypoint
        end then
        ((fun e =>
          Tezos_protocol_environment_alpha__Environment.Micheline.Prim 0
            Tezos_raw_protocol_alpha.Alpha_context.Script.D_Left (cons e []) []),
          (Ex_ty tl))
      else
        if
          match ar with
          | None => false
          | Some (Field_annot r) => op_eq r entrypoint
          end then
          ((fun e =>
            Tezos_protocol_environment_alpha__Environment.Micheline.Prim 0
              Tezos_raw_protocol_alpha.Alpha_context.Script.D_Right (cons e [])
              []), (Ex_ty tr))
        else
          (* ❌ Try-with are not handled *)
          try
            (let '(f, t) := find_entrypoint tl entrypoint in
            ((fun e =>
              Tezos_protocol_environment_alpha__Environment.Micheline.Prim 0
                Tezos_raw_protocol_alpha.Alpha_context.Script.D_Left
                (cons (f e) []) []), t))
    | _ => raise OCaml.Not_found
    end in
  let entrypoint :=
    if op_eq entrypoint "" % string then
      "default" % string
    else
      entrypoint in
  if op_gt (String.length entrypoint) 31 then
    __error_value
      (Tezos_protocol_environment_alpha__Environment.Error_monad.Entrypoint_name_too_long
        entrypoint)
  else
    match root_name with
    | Some root_name => ok ((fun e => e), (Ex_ty full))
    | _ =>
      (* ❌ Try-with are not handled *)
      try (ok (find_entrypoint full entrypoint))
    end.

Definition find_entrypoint_for_type {A B : Set}
  (full : Tezos_raw_protocol_alpha.Script_typed_ir.ty A)
  (expected : Tezos_raw_protocol_alpha.Script_typed_ir.ty B)
  (root_name :
    option Tezos_protocol_environment_alpha__Environment.Compare.String.t)
  (entrypoint : Tezos_protocol_environment_alpha__Environment.Compare.String.t)
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (Tezos_raw_protocol_alpha.Alpha_context.context * string *
      Tezos_raw_protocol_alpha.Script_typed_ir.ty B) :=
  match (entrypoint, root_name) with
  | ("default" % string, Some "root" % string) =>
    match find_entrypoint full root_name entrypoint with
    | (Tezos_protocol_environment_alpha__Environment.Pervasives.Error _) as err
      => err
    | Tezos_protocol_environment_alpha__Environment.Pervasives.Ok (_, Ex_ty ty)
      =>
      match ty_eq ctxt expected ty with
      | Tezos_protocol_environment_alpha__Environment.Pervasives.Ok (Eq, ctxt)
        => ok (ctxt, "default" % string, ty)
      | Tezos_protocol_environment_alpha__Environment.Pervasives.Error _ =>
        op_gtgtquestion (ty_eq ctxt expected full)
          (fun function_parameter =>
            let '(Eq, ctxt) := function_parameter in
            ok (ctxt, "root" % string, full))
      end
    end
  | _ =>
    op_gtgtquestion (find_entrypoint full root_name entrypoint)
      (fun function_parameter =>
        let '(_, Ex_ty ty) := function_parameter in
        op_gtgtquestion (ty_eq ctxt expected ty)
          (fun function_parameter =>
            let '(Eq, ctxt) := function_parameter in
            ok (ctxt, entrypoint, ty)))
  end.

(* ❌ Applications of functors are not handled. *)
functor_application

(* ❌ The definition of exceptions is not handled. *)
(* exception Duplicate *)

(* ❌ The definition of exceptions is not handled. *)
(* exception Too_long *)

Definition well_formed_entrypoints {A : Set}
  (full : Tezos_raw_protocol_alpha.Script_typed_ir.ty A)
  (root_name : option Entrypoints.elt)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit :=
  let merge {B C : Set}
    (path : list B) (annot : option (* `Field_annot *) Entrypoints.elt) (ty :
    Tezos_raw_protocol_alpha.Script_typed_ir.ty C) (reachable : bool)
    (function_parameter : option (list B) * Entrypoints.t)
    : option (list B) * Entrypoints.t :=
    let '(first_unreachable, all) as acc := function_parameter in
    match annot with
    | None | Some (Field_annot "" % string) =>
      if reachable then
        acc
      else
        match ty with
        | Tezos_raw_protocol_alpha.Script_typed_ir.Union_t _ _ _ _ => acc
        | _ =>
          match first_unreachable with
          | None => ((Some (List.rev path)), all)
          | Some _ => acc
          end
        end
    | Some (Field_annot name) =>
      if op_gt (String.length name) 31 then
        raise (Too_long name)
      else
        if Entrypoints.mem name all then
          raise (Duplicate name)
        else
          (first_unreachable, (Entrypoints.add name all))
    end in
  let fix check {t : Set}
    (t : Tezos_raw_protocol_alpha.Script_typed_ir.ty t) (path :
    list Tezos_raw_protocol_alpha.Alpha_context.Script.prim) (reachable : bool)
    (acc :
    option (list Tezos_raw_protocol_alpha.Alpha_context.Script.prim) *
      Entrypoints.t)
    : option (list Tezos_raw_protocol_alpha.Alpha_context.Script.prim) *
      Entrypoints.t :=
    match t with
    | Tezos_raw_protocol_alpha.Script_typed_ir.Union_t (tl, al) (tr, ar) _ _ =>
      let acc :=
        merge (cons Tezos_raw_protocol_alpha.Alpha_context.Script.D_Left path)
          al tl reachable acc in
      let acc :=
        merge (cons Tezos_raw_protocol_alpha.Alpha_context.Script.D_Right path)
          ar tr reachable acc in
      let acc :=
        check tl
          (cons Tezos_raw_protocol_alpha.Alpha_context.Script.D_Left path)
          match al with
          | Some _ => true
          | None => reachable
          end acc in
      check tr (cons Tezos_raw_protocol_alpha.Alpha_context.Script.D_Right path)
        match ar with
        | Some _ => true
        | None => reachable
        end acc
    | _ => acc
    end in
  (* ❌ Try-with are not handled *)
  try
    (let '(init, reachable) :=
      match root_name with
      | None | Some "" % string => (Entrypoints.empty, false)
      | Some name => ((Entrypoints.singleton name), true)
      end in
    let '(first_unreachable, all) := check full [] reachable (None, init) in
    if not (Entrypoints.mem "default" % string all) then
      ok tt
    else
      match first_unreachable with
      | None => ok tt
      | Some path =>
        __error_value
          (Tezos_protocol_environment_alpha__Environment.Error_monad.Unreachable_entrypoint
            path)
      end).

Fixpoint parse_data {a : Set}
  (type_logger : option type_logger)
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context) (legacy : bool)
  (ty : Tezos_raw_protocol_alpha.Script_typed_ir.ty a)
  (script_data : Tezos_raw_protocol_alpha.Alpha_context.Script.node)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (a * Tezos_raw_protocol_alpha.Alpha_context.context)) :=
  op_gtgteqquestion (Lwt.__return (Gas.consume ctxt Typecheck_costs.cycle))
    (fun ctxt =>
      let __error_value (function_parameter : unit)
        : Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
            Tezos_protocol_environment_alpha__Environment.Error_monad.__error) :=
        let 'tt := function_parameter in
        op_gtgtpipequestion (Lwt.__return (serialize_ty_for_error ctxt ty))
          (fun function_parameter =>
            let '(ty, _ctxt) := function_parameter in
            Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_constant
              (location script_data) (strip_locations script_data) ty) in
      let traced {B : Set}
        (body :
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult B))
        : Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult B) :=
        trace_eval __error_value body in
      let parse_items {B C D E : Set}
        (type_logger : option type_logger) (loc :
        Tezos_raw_protocol_alpha.Alpha_context.Script.location) (ctxt :
        Tezos_raw_protocol_alpha__Alpha_context.context) (expr :
        Tezos_protocol_environment_alpha__Environment.Micheline.node B
          Tezos_raw_protocol_alpha.Alpha_context.Script.prim) (key_type :
        Tezos_raw_protocol_alpha.Script_typed_ir.comparable_ty C) (value_type :
        Tezos_raw_protocol_alpha.Script_typed_ir.ty D) (items :
        list
          (Tezos_protocol_environment_alpha__Environment.Micheline.node
            Tezos_raw_protocol_alpha.Alpha_context.Script.location
            Tezos_raw_protocol_alpha.Alpha_context.Script.prim)) (item_wrapper :
        D -> E)
        : Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
            (Tezos_raw_protocol_alpha.Script_typed_ir.map C E *
              Tezos_raw_protocol_alpha__Alpha_context.context)) :=
        let length := List.length items in
        op_gtgtpipequestion
          (op_pipegt
            (fold_left_s
              (fun function_parameter =>
                let '(last_value, map, ctxt) := function_parameter in
                fun item =>
                  op_gtgteqquestion
                    (Lwt.__return
                      (Gas.consume ctxt (Typecheck_costs.map_element length)))
                    (fun ctxt =>
                      match item with
                      |
                        Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                          _ Tezos_raw_protocol_alpha.Alpha_context.Script.D_Elt
                          (cons k (cons v [])) _ =>
                        op_gtgteqquestion
                          (parse_comparable_data type_logger ctxt key_type k)
                          (fun function_parameter =>
                            let '(k, ctxt) := function_parameter in
                            op_gtgteqquestion
                              (parse_data type_logger ctxt legacy value_type v)
                              (fun function_parameter =>
                                let '(v, ctxt) := function_parameter in
                                op_gtgteqquestion
                                  match last_value with
                                  | Some value =>
                                    if
                                      op_lteq 0
                                        (compare_comparable key_type value k)
                                      then
                                      if
                                        op_eq 0
                                          (compare_comparable key_type value k)
                                        then
                                        fail
                                          (Tezos_protocol_environment_alpha__Environment.Error_monad.Duplicate_map_keys
                                            loc (strip_locations expr))
                                      else
                                        fail
                                          (Tezos_protocol_environment_alpha__Environment.Error_monad.Unordered_map_keys
                                            loc (strip_locations expr))
                                    else
                                      return_unit
                                  | None => return_unit
                                  end
                                  (fun function_parameter =>
                                    let 'tt := function_parameter in
                                    __return
                                      ((Some k),
                                        (map_update k (Some (item_wrapper v))
                                          map), ctxt))))
                      |
                        Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                          loc
                          Tezos_raw_protocol_alpha.Alpha_context.Script.D_Elt l
                          _ =>
                        op_atat fail
                          (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_arity
                            loc
                            Tezos_raw_protocol_alpha.Alpha_context.Script.D_Elt
                            2 (List.length l))
                      |
                        Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                          loc name _ _ =>
                        op_atat fail
                          (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_primitive
                            loc
                            (cons
                              Tezos_raw_protocol_alpha.Alpha_context.Script.D_Elt
                              []) name)
                      |
                        Tezos_protocol_environment_alpha__Environment.Micheline.Int
                          _ _ |
                          Tezos_protocol_environment_alpha__Environment.Micheline.String
                            _ _ |
                          Tezos_protocol_environment_alpha__Environment.Micheline.Bytes
                            _ _ |
                          Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                            _ _ => op_gtgteqquestion (__error_value tt) fail
                      end)) (None, (empty_map key_type), ctxt) items) traced)
          (fun function_parameter =>
            let '(_, items, ctxt) := function_parameter in
            (items, ctxt)) in
      match (ty, script_data) with
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Unit_t _,
          Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
            Tezos_raw_protocol_alpha.Alpha_context.Script.D_Unit [] annot) =>
        op_gtgteqquestion
          (if legacy then
            __return tt
          else
            fail_unexpected_annot loc annot)
          (fun function_parameter =>
            let 'tt := function_parameter in
            op_gtgtpipequestion
              (Lwt.__return (Gas.consume ctxt Typecheck_costs.__unit_value))
              (fun ctxt => (tt, ctxt)))
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Unit_t _,
          Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
            Tezos_raw_protocol_alpha.Alpha_context.Script.D_Unit l _) =>
        traced
          (fail
            (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_arity
              loc Tezos_raw_protocol_alpha.Alpha_context.Script.D_Unit 0
              (List.length l)))
      | (Tezos_raw_protocol_alpha.Script_typed_ir.Unit_t _, expr) =>
        traced
          (fail
            (unexpected expr []
              Tezos_raw_protocol_alpha.Script_tc_errors.Constant_namespace
              (cons Tezos_raw_protocol_alpha.Alpha_context.Script.D_Unit [])))
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t _,
          Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
            Tezos_raw_protocol_alpha.Alpha_context.Script.D_True [] annot) =>
        op_gtgteqquestion
          (if legacy then
            __return tt
          else
            fail_unexpected_annot loc annot)
          (fun function_parameter =>
            let 'tt := function_parameter in
            op_gtgtpipequestion
              (Lwt.__return (Gas.consume ctxt Typecheck_costs.__bool_value))
              (fun ctxt => (true, ctxt)))
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t _,
          Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
            Tezos_raw_protocol_alpha.Alpha_context.Script.D_False [] annot) =>
        op_gtgteqquestion
          (if legacy then
            __return tt
          else
            fail_unexpected_annot loc annot)
          (fun function_parameter =>
            let 'tt := function_parameter in
            op_gtgtpipequestion
              (Lwt.__return (Gas.consume ctxt Typecheck_costs.__bool_value))
              (fun ctxt => (false, ctxt)))
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t _,
          Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
            ((Tezos_raw_protocol_alpha.Alpha_context.Script.D_True |
              Tezos_raw_protocol_alpha.Alpha_context.Script.D_False) as c) l _)
        =>
        traced
          (fail
            (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_arity
              loc c 0 (List.length l)))
      | (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t _, expr) =>
        traced
          (fail
            (unexpected expr []
              Tezos_raw_protocol_alpha.Script_tc_errors.Constant_namespace
              (cons Tezos_raw_protocol_alpha.Alpha_context.Script.D_True
                (cons Tezos_raw_protocol_alpha.Alpha_context.Script.D_False []))))
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.String_t _,
          Tezos_protocol_environment_alpha__Environment.Micheline.String _ v) =>
        op_gtgteqquestion
          (Lwt.__return
            (Gas.consume ctxt (Typecheck_costs.__string_value (String.length v))))
          (fun ctxt =>
            let fix check_printable_ascii
              (i : Tezos_protocol_environment_alpha__Environment.Compare.Int.t)
              : bool :=
              if op_lt i 0 then
                true
              else
                match String.get v i with
                |
                  "010" % char |
                    " " % char |
                      "!" % char |
                        """" % char |
                          "#" % char |
                            "$" % char |
                              "%" % char |
                                "&" % char |
                                  "'" % char |
                                    "(" % char |
                                      ")" % char |
                                        "*" % char |
                                          "+" % char |
                                            "," % char |
                                              "-" % char |
                                                "." % char |
                                                  "/" % char |
                                                    "0" % char |
                                                      "1" % char |
                                                        "2" % char |
                                                          "3" % char |
                                                            "4" % char |
                                                              "5" % char |
                                                                "6" % char |
                                                                  "7" % char |
                                                                    "8" % char |
                                                                      "9" % char
                                                                        |
                                                                        ":" %
                                                                          char |
                                                                          ";" %
                                                                            char
                                                                            |
                                                                            "<"
                                                                              %
                                                                              char
                                                                              |
                                                                              "="
                                                                                %
                                                                                char
                                                                                |
                                                                                ">"
                                                                                  %
                                                                                  char
                                                                                  |
                                                                                  "?"
                                                                                    %
                                                                                    char
                                                                                    |
                                                                                    "@"
                                                                                      %
                                                                                      char
                                                                                      |
                                                                                      "A"
                                                                                        %
                                                                                        char
                                                                                        |
                                                                                        "B"
                                                                                          %
                                                                                          char
                                                                                          |
                                                                                          "C"
                                                                                            %
                                                                                            char
                                                                                            |
                                                                                            "D"
                                                                                              %
                                                                                              char
                                                                                              |
                                                                                              "E"
                                                                                                %
                                                                                                char
                                                                                                |
                                                                                                "F"
                                                                                                  %
                                                                                                  char
                                                                                                  |
                                                                                                  "G"
                                                                                                    %
                                                                                                    char
                                                                                                    |
                                                                                                    "H"
                                                                                                      %
                                                                                                      char
                                                                                                      |
                                                                                                      "I"
                                                                                                        %
                                                                                                        char
                                                                                                        |
                                                                                                        "J"
                                                                                                          %
                                                                                                          char
                                                                                                          |
                                                                                                          "K"
                                                                                                            %
                                                                                                            char
                                                                                                            |
                                                                                                            "L"
                                                                                                              %
                                                                                                              char
                                                                                                              |
                                                                                                              "M"
                                                                                                                %
                                                                                                                char
                                                                                                                |
                                                                                                                "N"
                                                                                                                  %
                                                                                                                  char
                                                                                                                  |
                                                                                                                  "O"
                                                                                                                    %
                                                                                                                    char
                                                                                                                    |
                                                                                                                    "P"
                                                                                                                      %
                                                                                                                      char
                                                                                                                      |
                                                                                                                      "Q"
                                                                                                                        %
                                                                                                                        char
                                                                                                                        |
                                                                                                                        "R"
                                                                                                                          %
                                                                                                                          char
                                                                                                                          |
                                                                                                                          "S"
                                                                                                                            %
                                                                                                                            char
                                                                                                                            |
                                                                                                                            "T"
                                                                                                                              %
                                                                                                                              char
                                                                                                                              |
                                                                                                                              "U"
                                                                                                                                %
                                                                                                                                char
                                                                                                                                |
                                                                                                                                "V"
                                                                                                                                  %
                                                                                                                                  char
                                                                                                                                  |
                                                                                                                                  "W"
                                                                                                                                    %
                                                                                                                                    char
                                                                                                                                    |
                                                                                                                                    "X"
                                                                                                                                      %
                                                                                                                                      char
                                                                                                                                      |
                                                                                                                                      "Y"
                                                                                                                                        %
                                                                                                                                        char
                                                                                                                                        |
                                                                                                                                        "Z"
                                                                                                                                          %
                                                                                                                                          char
                                                                                                                                          |
                                                                                                                                          "["
                                                                                                                                            %
                                                                                                                                            char
                                                                                                                                            |
                                                                                                                                            "\"
                                                                                                                                              %
                                                                                                                                              char
                                                                                                                                              |
                                                                                                                                              "]"
                                                                                                                                                %
                                                                                                                                                char
                                                                                                                                                |
                                                                                                                                                "^"
                                                                                                                                                  %
                                                                                                                                                  char
                                                                                                                                                  |
                                                                                                                                                  "_"
                                                                                                                                                    %
                                                                                                                                                    char
                                                                                                                                                    |
                                                                                                                                                    "`"
                                                                                                                                                      %
                                                                                                                                                      char
                                                                                                                                                      |
                                                                                                                                                      "a"
                                                                                                                                                        %
                                                                                                                                                        char
                                                                                                                                                        |
                                                                                                                                                        "b"
                                                                                                                                                          %
                                                                                                                                                          char
                                                                                                                                                          |
                                                                                                                                                          "c"
                                                                                                                                                            %
                                                                                                                                                            char
                                                                                                                                                            |
                                                                                                                                                            "d"
                                                                                                                                                              %
                                                                                                                                                              char
                                                                                                                                                              |
                                                                                                                                                              "e"
                                                                                                                                                                %
                                                                                                                                                                char
                                                                                                                                                                |
                                                                                                                                                                "f"
                                                                                                                                                                  %
                                                                                                                                                                  char
                                                                                                                                                                  |
                                                                                                                                                                  "g"
                                                                                                                                                                    %
                                                                                                                                                                    char
                                                                                                                                                                    |
                                                                                                                                                                    "h"
                                                                                                                                                                      %
                                                                                                                                                                      char
                                                                                                                                                                      |
                                                                                                                                                                      "i"
                                                                                                                                                                        %
                                                                                                                                                                        char
                                                                                                                                                                        |
                                                                                                                                                                        "j"
                                                                                                                                                                          %
                                                                                                                                                                          char
                                                                                                                                                                          |
                                                                                                                                                                          "k"
                                                                                                                                                                            %
                                                                                                                                                                            char
                                                                                                                                                                            |
                                                                                                                                                                            "l"
                                                                                                                                                                              %
                                                                                                                                                                              char
                                                                                                                                                                              |
                                                                                                                                                                              "m"
                                                                                                                                                                                %
                                                                                                                                                                                char
                                                                                                                                                                                |
                                                                                                                                                                                "n"
                                                                                                                                                                                  %
                                                                                                                                                                                  char
                                                                                                                                                                                  |
                                                                                                                                                                                  "o"
                                                                                                                                                                                    %
                                                                                                                                                                                    char
                                                                                                                                                                                    |
                                                                                                                                                                                    "p"
                                                                                                                                                                                      %
                                                                                                                                                                                      char
                                                                                                                                                                                      |
                                                                                                                                                                                      "q"
                                                                                                                                                                                        %
                                                                                                                                                                                        char
                                                                                                                                                                                        |
                                                                                                                                                                                        "r"
                                                                                                                                                                                          %
                                                                                                                                                                                          char
                                                                                                                                                                                          |
                                                                                                                                                                                          "s"
                                                                                                                                                                                            %
                                                                                                                                                                                            char
                                                                                                                                                                                            |
                                                                                                                                                                                            "t"
                                                                                                                                                                                              %
                                                                                                                                                                                              char
                                                                                                                                                                                              |
                                                                                                                                                                                              "u"
                                                                                                                                                                                                %
                                                                                                                                                                                                char
                                                                                                                                                                                                |
                                                                                                                                                                                                "v"
                                                                                                                                                                                                  %
                                                                                                                                                                                                  char
                                                                                                                                                                                                  |
                                                                                                                                                                                                  "w"
                                                                                                                                                                                                    %
                                                                                                                                                                                                    char
                                                                                                                                                                                                    |
                                                                                                                                                                                                    "x"
                                                                                                                                                                                                      %
                                                                                                                                                                                                      char
                                                                                                                                                                                                      |
                                                                                                                                                                                                      "y"
                                                                                                                                                                                                        %
                                                                                                                                                                                                        char
                                                                                                                                                                                                        |
                                                                                                                                                                                                        "z"
                                                                                                                                                                                                          %
                                                                                                                                                                                                          char
                                                                                                                                                                                                          |
                                                                                                                                                                                                          "{"
                                                                                                                                                                                                            %
                                                                                                                                                                                                            char
                                                                                                                                                                                                            |
                                                                                                                                                                                                            "|"
                                                                                                                                                                                                              %
                                                                                                                                                                                                              char
                                                                                                                                                                                                              |
                                                                                                                                                                                                              "}"
                                                                                                                                                                                                                %
                                                                                                                                                                                                                char
                                                                                                                                                                                                                |
                                                                                                                                                                                                                "~"
                                                                                                                                                                                                                  %
                                                                                                                                                                                                                  char
                  => check_printable_ascii (op_minus i 1)
                | _ => false
                end in
            if check_printable_ascii (op_minus (String.length v) 1) then
              __return (v, ctxt)
            else
              op_gtgteqquestion (__error_value tt) fail)
      | (Tezos_raw_protocol_alpha.Script_typed_ir.String_t _, expr) =>
        traced
          (fail
            (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_kind
              (location expr)
              (cons Tezos_raw_protocol_alpha.Script_tc_errors.String_kind [])
              (kind expr)))
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_t _,
          Tezos_protocol_environment_alpha__Environment.Micheline.Bytes _ v) =>
        op_gtgteqquestion
          (Lwt.__return
            (Gas.consume ctxt (Typecheck_costs.__string_value (MBytes.length v))))
          (fun ctxt => __return (v, ctxt))
      | (Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_t _, expr) =>
        traced
          (fail
            (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_kind
              (location expr)
              (cons Tezos_raw_protocol_alpha.Script_tc_errors.Bytes_kind [])
              (kind expr)))
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t _,
          Tezos_protocol_environment_alpha__Environment.Micheline.Int _ v) =>
        op_gtgteqquestion
          (Lwt.__return (Gas.consume ctxt (Typecheck_costs.z v)))
          (fun ctxt => __return ((Script_int.of_zint v), ctxt))
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t _,
          Tezos_protocol_environment_alpha__Environment.Micheline.Int _ v) =>
        op_gtgteqquestion
          (Lwt.__return (Gas.consume ctxt (Typecheck_costs.z v)))
          (fun ctxt =>
            let v := Script_int.of_zint v in
            if op_gteq (Script_int.compare v Script_int.zero) 0 then
              __return ((Script_int.abs v), ctxt)
            else
              op_gtgteqquestion (__error_value tt) fail)
      | (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t _, expr) =>
        traced
          (fail
            (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_kind
              (location expr)
              (cons Tezos_raw_protocol_alpha.Script_tc_errors.Int_kind [])
              (kind expr)))
      | (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t _, expr) =>
        traced
          (fail
            (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_kind
              (location expr)
              (cons Tezos_raw_protocol_alpha.Script_tc_errors.Int_kind [])
              (kind expr)))
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_t _,
          Tezos_protocol_environment_alpha__Environment.Micheline.Int _ v) =>
        op_gtgteqquestion
          (Lwt.__return
            (op_gtgtquestion (Gas.consume ctxt Typecheck_costs.tez)
              (fun ctxt =>
                Gas.consume ctxt Michelson_v1_gas.Cost_of.Legacy.z_to_int64)))
          (fun ctxt =>
            (* ❌ Try-with are not handled *)
            try
              match Tez.of_mutez (Z.to_int64 v) with
              | None => raise Exit
              | Some tez => __return (tez, ctxt)
              end)
      | (Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_t _, expr) =>
        traced
          (fail
            (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_kind
              (location expr)
              (cons Tezos_raw_protocol_alpha.Script_tc_errors.Int_kind [])
              (kind expr)))
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_t _,
          Tezos_protocol_environment_alpha__Environment.Micheline.Int _ v) =>
        op_gtgteqquestion
          (Lwt.__return (Gas.consume ctxt (Typecheck_costs.z v)))
          (fun ctxt => __return ((Script_timestamp.of_zint v), ctxt))
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_t _,
          Tezos_protocol_environment_alpha__Environment.Micheline.String _ s) =>
        op_gtgteqquestion
          (Lwt.__return (Gas.consume ctxt Typecheck_costs.string_timestamp))
          (fun ctxt =>
            match Script_timestamp.of_string s with
            | Some v => __return (v, ctxt)
            | None => op_gtgteqquestion (__error_value tt) fail
            end)
      | (Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_t _, expr) =>
        traced
          (fail
            (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_kind
              (location expr)
              (cons Tezos_raw_protocol_alpha.Script_tc_errors.String_kind
                (cons Tezos_raw_protocol_alpha.Script_tc_errors.Int_kind []))
              (kind expr)))
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Key_t _,
          Tezos_protocol_environment_alpha__Environment.Micheline.Bytes _
            __bytes_value) =>
        op_gtgteqquestion (Lwt.__return (Gas.consume ctxt Typecheck_costs.key))
          (fun ctxt =>
            match
              Data_encoding.Binary.of_bytes Signature.Public_key.encoding
                __bytes_value with
            | Some k => __return (k, ctxt)
            | None => op_gtgteqquestion (__error_value tt) fail
            end)
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Key_t _,
          Tezos_protocol_environment_alpha__Environment.Micheline.String _ s) =>
        op_gtgteqquestion (Lwt.__return (Gas.consume ctxt Typecheck_costs.key))
          (fun ctxt =>
            match Signature.Public_key.of_b58check_opt s with
            | Some k => __return (k, ctxt)
            | None => op_gtgteqquestion (__error_value tt) fail
            end)
      | (Tezos_raw_protocol_alpha.Script_typed_ir.Key_t _, expr) =>
        traced
          (fail
            (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_kind
              (location expr)
              (cons Tezos_raw_protocol_alpha.Script_tc_errors.String_kind
                (cons Tezos_raw_protocol_alpha.Script_tc_errors.Bytes_kind []))
              (kind expr)))
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_t _,
          Tezos_protocol_environment_alpha__Environment.Micheline.Bytes _
            __bytes_value) =>
        op_gtgteqquestion
          (Lwt.__return (Gas.consume ctxt Typecheck_costs.key_hash))
          (fun ctxt =>
            match
              Data_encoding.Binary.of_bytes Signature.Public_key_hash.encoding
                __bytes_value with
            | Some k => __return (k, ctxt)
            | None => op_gtgteqquestion (__error_value tt) fail
            end)
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_t _,
          Tezos_protocol_environment_alpha__Environment.Micheline.String _ s) =>
        op_gtgteqquestion
          (Lwt.__return (Gas.consume ctxt Typecheck_costs.key_hash))
          (fun ctxt =>
            match Signature.Public_key_hash.of_b58check_opt s with
            | Some k => __return (k, ctxt)
            | None => op_gtgteqquestion (__error_value tt) fail
            end)
      | (Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_t _, expr) =>
        traced
          (fail
            (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_kind
              (location expr)
              (cons Tezos_raw_protocol_alpha.Script_tc_errors.String_kind
                (cons Tezos_raw_protocol_alpha.Script_tc_errors.Bytes_kind []))
              (kind expr)))
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Signature_t _,
          Tezos_protocol_environment_alpha__Environment.Micheline.Bytes _
            __bytes_value) =>
        op_gtgteqquestion
          (Lwt.__return (Gas.consume ctxt Typecheck_costs.signature))
          (fun ctxt =>
            match Data_encoding.Binary.of_bytes Signature.encoding __bytes_value
              with
            | Some k => __return (k, ctxt)
            | None => op_gtgteqquestion (__error_value tt) fail
            end)
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Signature_t _,
          Tezos_protocol_environment_alpha__Environment.Micheline.String _ s) =>
        op_gtgteqquestion
          (Lwt.__return (Gas.consume ctxt Typecheck_costs.signature))
          (fun ctxt =>
            match Signature.of_b58check_opt s with
            | Some s => __return (s, ctxt)
            | None => op_gtgteqquestion (__error_value tt) fail
            end)
      | (Tezos_raw_protocol_alpha.Script_typed_ir.Signature_t _, expr) =>
        traced
          (fail
            (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_kind
              (location expr)
              (cons Tezos_raw_protocol_alpha.Script_tc_errors.String_kind
                (cons Tezos_raw_protocol_alpha.Script_tc_errors.Bytes_kind []))
              (kind expr)))
      | (Tezos_raw_protocol_alpha.Script_typed_ir.Operation_t _, _) =>
        (* ❌ Assert instruction is not handled. *)
        assert false
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Chain_id_t _,
          Tezos_protocol_environment_alpha__Environment.Micheline.Bytes _
            __bytes_value) =>
        op_gtgteqquestion
          (Lwt.__return (Gas.consume ctxt Typecheck_costs.chain_id))
          (fun ctxt =>
            match Data_encoding.Binary.of_bytes Chain_id.encoding __bytes_value
              with
            | Some k => __return (k, ctxt)
            | None => op_gtgteqquestion (__error_value tt) fail
            end)
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Chain_id_t _,
          Tezos_protocol_environment_alpha__Environment.Micheline.String _ s) =>
        op_gtgteqquestion
          (Lwt.__return (Gas.consume ctxt Typecheck_costs.chain_id))
          (fun ctxt =>
            match Chain_id.of_b58check_opt s with
            | Some s => __return (s, ctxt)
            | None => op_gtgteqquestion (__error_value tt) fail
            end)
      | (Tezos_raw_protocol_alpha.Script_typed_ir.Chain_id_t _, expr) =>
        traced
          (fail
            (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_kind
              (location expr)
              (cons Tezos_raw_protocol_alpha.Script_tc_errors.String_kind
                (cons Tezos_raw_protocol_alpha.Script_tc_errors.Bytes_kind []))
              (kind expr)))
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Address_t _,
          Tezos_protocol_environment_alpha__Environment.Micheline.Bytes loc
            __bytes_value) =>
        op_gtgteqquestion
          (Lwt.__return (Gas.consume ctxt Typecheck_costs.contract))
          (fun ctxt =>
            match
              Data_encoding.Binary.of_bytes
                (tup2 Contract.encoding __Variable.__string_value) __bytes_value
              with
            | Some (c, entrypoint) =>
              if op_gt (String.length entrypoint) 31 then
                fail
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.Entrypoint_name_too_long
                    entrypoint)
              else
                op_gtgteqquestion
                  match entrypoint with
                  | "" % string => __return "default" % string
                  | "default" % string =>
                    fail
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_annotation
                        loc)
                  | name => __return name
                  end (fun entrypoint => __return ((c, entrypoint), ctxt))
            | None => op_gtgteqquestion (__error_value tt) fail
            end)
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Address_t _,
          Tezos_protocol_environment_alpha__Environment.Micheline.String loc s)
        =>
        op_gtgteqquestion
          (Lwt.__return (Gas.consume ctxt Typecheck_costs.contract))
          (fun ctxt =>
            op_gtgteqquestion
              match String.index_opt s "%" % char with
              | None => __return (s, "default" % string)
              | Some pos =>
                let len := op_minus (op_minus (String.length s) pos) 1 in
                let name := String.sub s (op_plus pos 1) len in
                if op_gt len 31 then
                  fail
                    (Tezos_protocol_environment_alpha__Environment.Error_monad.Entrypoint_name_too_long
                      name)
                else
                  match ((String.sub s 0 pos), name) with
                  | (_, "default" % string) =>
                    traced
                      (fail
                        (Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_annotation
                          loc))
                  | addr_and_name => __return addr_and_name
                  end
              end
              (fun function_parameter =>
                let '(addr, entrypoint) := function_parameter in
                op_gtgteqquestion (Lwt.__return (Contract.of_b58check addr))
                  (fun c => __return ((c, entrypoint), ctxt))))
      | (Tezos_raw_protocol_alpha.Script_typed_ir.Address_t _, expr) =>
        traced
          (fail
            (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_kind
              (location expr)
              (cons Tezos_raw_protocol_alpha.Script_tc_errors.String_kind
                (cons Tezos_raw_protocol_alpha.Script_tc_errors.Bytes_kind []))
              (kind expr)))
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Contract_t ty _,
          Tezos_protocol_environment_alpha__Environment.Micheline.Bytes loc
            __bytes_value) =>
        op_gtgteqquestion
          (Lwt.__return (Gas.consume ctxt Typecheck_costs.contract))
          (fun ctxt =>
            match
              Data_encoding.Binary.of_bytes
                (tup2 Contract.encoding __Variable.__string_value) __bytes_value
              with
            | Some (c, entrypoint) =>
              if op_gt (String.length entrypoint) 31 then
                fail
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.Entrypoint_name_too_long
                    entrypoint)
              else
                op_gtgteqquestion
                  match entrypoint with
                  | "" % string => __return "default" % string
                  | "default" % string =>
                    traced
                      (fail
                        (Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_annotation
                          loc))
                  | name => __return name
                  end
                  (fun entrypoint =>
                    op_gtgteqquestion
                      (traced (parse_contract legacy ctxt loc ty c entrypoint))
                      (fun function_parameter =>
                        let '(ctxt, _) := function_parameter in
                        __return ((ty, (c, entrypoint)), ctxt)))
            | None => op_gtgteqquestion (__error_value tt) fail
            end)
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Contract_t ty _,
          Tezos_protocol_environment_alpha__Environment.Micheline.String loc s)
        =>
        op_gtgteqquestion
          (Lwt.__return (Gas.consume ctxt Typecheck_costs.contract))
          (fun ctxt =>
            op_gtgteqquestion
              match String.index_opt s "%" % char with
              | None => __return (s, "default" % string)
              | Some pos =>
                let len := op_minus (op_minus (String.length s) pos) 1 in
                let name := String.sub s (op_plus pos 1) len in
                if op_gt len 31 then
                  fail
                    (Tezos_protocol_environment_alpha__Environment.Error_monad.Entrypoint_name_too_long
                      name)
                else
                  match ((String.sub s 0 pos), name) with
                  | (_, "default" % string) =>
                    traced
                      (fail
                        (Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_annotation
                          loc))
                  | addr_and_name => __return addr_and_name
                  end
              end
              (fun function_parameter =>
                let '(addr, entrypoint) := function_parameter in
                op_gtgteqquestion
                  (traced (Lwt.__return (Contract.of_b58check addr)))
                  (fun c =>
                    op_gtgteqquestion
                      (parse_contract legacy ctxt loc ty c entrypoint)
                      (fun function_parameter =>
                        let '(ctxt, _) := function_parameter in
                        __return ((ty, (c, entrypoint)), ctxt)))))
      | (Tezos_raw_protocol_alpha.Script_typed_ir.Contract_t _ _, expr) =>
        traced
          (fail
            (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_kind
              (location expr)
              (cons Tezos_raw_protocol_alpha.Script_tc_errors.String_kind
                (cons Tezos_raw_protocol_alpha.Script_tc_errors.Bytes_kind []))
              (kind expr)))
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t (ta, _, _) (tb, _, _) _
          _,
          Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
            Tezos_raw_protocol_alpha.Alpha_context.Script.D_Pair
            (cons va (cons vb [])) annot) =>
        op_gtgteqquestion
          (if legacy then
            __return tt
          else
            fail_unexpected_annot loc annot)
          (fun function_parameter =>
            let 'tt := function_parameter in
            op_gtgteqquestion
              (Lwt.__return (Gas.consume ctxt Typecheck_costs.pair))
              (fun ctxt =>
                op_gtgteqquestion
                  (op_atat traced (parse_data type_logger ctxt legacy ta va))
                  (fun function_parameter =>
                    let '(va, ctxt) := function_parameter in
                    op_gtgteqquestion (parse_data type_logger ctxt legacy tb vb)
                      (fun function_parameter =>
                        let '(vb, ctxt) := function_parameter in
                        __return ((va, vb), ctxt)))))
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t _ _ _ _,
          Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
            Tezos_raw_protocol_alpha.Alpha_context.Script.D_Pair l _) =>
        op_atat fail
          (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_arity
            loc Tezos_raw_protocol_alpha.Alpha_context.Script.D_Pair 2
            (List.length l))
      | (Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t _ _ _ _, expr) =>
        traced
          (fail
            (unexpected expr []
              Tezos_raw_protocol_alpha.Script_tc_errors.Constant_namespace
              (cons Tezos_raw_protocol_alpha.Alpha_context.Script.D_Pair [])))
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Union_t (tl, _) _ _ _,
          Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
            Tezos_raw_protocol_alpha.Alpha_context.Script.D_Left (cons v [])
            annot) =>
        op_gtgteqquestion
          (if legacy then
            __return tt
          else
            fail_unexpected_annot loc annot)
          (fun function_parameter =>
            let 'tt := function_parameter in
            op_gtgteqquestion
              (Lwt.__return (Gas.consume ctxt Typecheck_costs.union))
              (fun ctxt =>
                op_gtgteqquestion
                  (op_atat traced (parse_data type_logger ctxt legacy tl v))
                  (fun function_parameter =>
                    let '(v, ctxt) := function_parameter in
                    __return
                      ((Tezos_raw_protocol_alpha.Script_typed_ir.L v), ctxt))))
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Union_t _ _ _ _,
          Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
            Tezos_raw_protocol_alpha.Alpha_context.Script.D_Left l _) =>
        op_atat fail
          (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_arity
            loc Tezos_raw_protocol_alpha.Alpha_context.Script.D_Left 1
            (List.length l))
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Union_t _ (tr, _) _ _,
          Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
            Tezos_raw_protocol_alpha.Alpha_context.Script.D_Right (cons v [])
            annot) =>
        op_gtgteqquestion (fail_unexpected_annot loc annot)
          (fun function_parameter =>
            let 'tt := function_parameter in
            op_gtgteqquestion
              (Lwt.__return (Gas.consume ctxt Typecheck_costs.union))
              (fun ctxt =>
                op_gtgteqquestion
                  (op_atat traced (parse_data type_logger ctxt legacy tr v))
                  (fun function_parameter =>
                    let '(v, ctxt) := function_parameter in
                    __return
                      ((Tezos_raw_protocol_alpha.Script_typed_ir.R v), ctxt))))
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Union_t _ _ _ _,
          Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
            Tezos_raw_protocol_alpha.Alpha_context.Script.D_Right l _) =>
        op_atat fail
          (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_arity
            loc Tezos_raw_protocol_alpha.Alpha_context.Script.D_Right 1
            (List.length l))
      | (Tezos_raw_protocol_alpha.Script_typed_ir.Union_t _ _ _ _, expr) =>
        traced
          (fail
            (unexpected expr []
              Tezos_raw_protocol_alpha.Script_tc_errors.Constant_namespace
              (cons Tezos_raw_protocol_alpha.Alpha_context.Script.D_Left
                (cons Tezos_raw_protocol_alpha.Alpha_context.Script.D_Right []))))
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Lambda_t ta tr _ty_name,
          (Tezos_protocol_environment_alpha__Environment.Micheline.Seq _loc _)
            as script_instr) =>
        op_gtgteqquestion
          (Lwt.__return (Gas.consume ctxt Typecheck_costs.lambda))
          (fun ctxt =>
            op_atat traced
              (parse_returning type_logger Lambda ctxt legacy
                (ta,
                  (Some
                    (* ❌ Variants not supported *)
                    variant)) tr script_instr))
      | (Tezos_raw_protocol_alpha.Script_typed_ir.Lambda_t _ _ _, expr) =>
        traced
          (fail
            (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_kind
              (location expr)
              (cons Tezos_raw_protocol_alpha.Script_tc_errors.Seq_kind [])
              (kind expr)))
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Option_t t _ _,
          Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
            Tezos_raw_protocol_alpha.Alpha_context.Script.D_Some (cons v [])
            annot) =>
        op_gtgteqquestion
          (if legacy then
            __return tt
          else
            fail_unexpected_annot loc annot)
          (fun function_parameter =>
            let 'tt := function_parameter in
            op_gtgteqquestion
              (Lwt.__return (Gas.consume ctxt Typecheck_costs.some))
              (fun ctxt =>
                op_gtgteqquestion
                  (op_atat traced (parse_data type_logger ctxt legacy t v))
                  (fun function_parameter =>
                    let '(v, ctxt) := function_parameter in
                    __return ((Some v), ctxt))))
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Option_t _ _ _,
          Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
            Tezos_raw_protocol_alpha.Alpha_context.Script.D_Some l _) =>
        op_atat fail
          (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_arity
            loc Tezos_raw_protocol_alpha.Alpha_context.Script.D_Some 1
            (List.length l))
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Option_t _ _ _,
          Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
            Tezos_raw_protocol_alpha.Alpha_context.Script.D_None [] annot) =>
        op_gtgteqquestion
          (if legacy then
            __return tt
          else
            fail_unexpected_annot loc annot)
          (fun function_parameter =>
            let 'tt := function_parameter in
            op_gtgteqquestion
              (Lwt.__return (Gas.consume ctxt Typecheck_costs.none))
              (fun ctxt => __return (None, ctxt)))
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Option_t _ _ _,
          Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
            Tezos_raw_protocol_alpha.Alpha_context.Script.D_None l _) =>
        op_atat fail
          (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_arity
            loc Tezos_raw_protocol_alpha.Alpha_context.Script.D_None 0
            (List.length l))
      | (Tezos_raw_protocol_alpha.Script_typed_ir.Option_t _ _ _, expr) =>
        traced
          (fail
            (unexpected expr []
              Tezos_raw_protocol_alpha.Script_tc_errors.Constant_namespace
              (cons Tezos_raw_protocol_alpha.Alpha_context.Script.D_Some
                (cons Tezos_raw_protocol_alpha.Alpha_context.Script.D_None []))))
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.List_t t _ty_name _,
          Tezos_protocol_environment_alpha__Environment.Micheline.Seq _loc items)
        =>
        op_atat traced
          (fold_right_s
            (fun v =>
              fun function_parameter =>
                let '(rest, ctxt) := function_parameter in
                op_gtgteqquestion
                  (Lwt.__return (Gas.consume ctxt Typecheck_costs.list_element))
                  (fun ctxt =>
                    op_gtgteqquestion (parse_data type_logger ctxt legacy t v)
                      (fun function_parameter =>
                        let '(v, ctxt) := function_parameter in
                        __return ((cons v rest), ctxt)))) items ([], ctxt))
      | (Tezos_raw_protocol_alpha.Script_typed_ir.List_t _ _ _, expr) =>
        traced
          (fail
            (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_kind
              (location expr)
              (cons Tezos_raw_protocol_alpha.Script_tc_errors.Seq_kind [])
              (kind expr)))
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Set_t t _ty_name,
          (Tezos_protocol_environment_alpha__Environment.Micheline.Seq loc vs)
            as expr) =>
        let length := List.length vs in
        op_gtgtpipequestion
          (op_atat traced
            (fold_left_s
              (fun function_parameter =>
                let '(last_value, set, ctxt) := function_parameter in
                fun v =>
                  op_gtgteqquestion
                    (Lwt.__return
                      (Gas.consume ctxt (Typecheck_costs.set_element length)))
                    (fun ctxt =>
                      op_gtgteqquestion
                        (parse_comparable_data type_logger ctxt t v)
                        (fun function_parameter =>
                          let '(v, ctxt) := function_parameter in
                          op_gtgteqquestion
                            match last_value with
                            | Some value =>
                              if op_lteq 0 (compare_comparable t value v) then
                                if op_eq 0 (compare_comparable t value v) then
                                  fail
                                    (Tezos_protocol_environment_alpha__Environment.Error_monad.Duplicate_set_values
                                      loc (strip_locations expr))
                                else
                                  fail
                                    (Tezos_protocol_environment_alpha__Environment.Error_monad.Unordered_set_values
                                      loc (strip_locations expr))
                              else
                                return_unit
                            | None => return_unit
                            end
                            (fun function_parameter =>
                              let 'tt := function_parameter in
                              op_gtgteqquestion
                                (Lwt.__return
                                  (Gas.consume ctxt
                                    (Michelson_v1_gas.Cost_of.Legacy.set_update
                                      v false set)))
                                (fun ctxt =>
                                  __return
                                    ((Some v), (set_update v true set), ctxt))))))
              (None, (empty_set t), ctxt) vs))
          (fun function_parameter =>
            let '(_, set, ctxt) := function_parameter in
            (set, ctxt))
      | (Tezos_raw_protocol_alpha.Script_typed_ir.Set_t _ _, expr) =>
        traced
          (fail
            (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_kind
              (location expr)
              (cons Tezos_raw_protocol_alpha.Script_tc_errors.Seq_kind [])
              (kind expr)))
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Map_t tk tv _ty_name _,
          (Tezos_protocol_environment_alpha__Environment.Micheline.Seq loc vs)
            as expr) =>
        parse_items type_logger loc ctxt expr tk tv vs (fun x => x)
      | (Tezos_raw_protocol_alpha.Script_typed_ir.Map_t _ _ _ _, expr) =>
        traced
          (fail
            (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_kind
              (location expr)
              (cons Tezos_raw_protocol_alpha.Script_tc_errors.Seq_kind [])
              (kind expr)))
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Big_map_t tk tv _ty_name,
          (Tezos_protocol_environment_alpha__Environment.Micheline.Seq loc vs)
            as expr) =>
        op_gtgtpipequestion
          (parse_items type_logger loc ctxt expr tk tv vs (fun x => Some x))
          (fun function_parameter =>
            let '(diff, ctxt) := function_parameter in
            ({| Tezos_raw_protocol_alpha.Script_typed_ir.big_map.id := None;
              Tezos_raw_protocol_alpha.Script_typed_ir.big_map.diff := diff;
              Tezos_raw_protocol_alpha.Script_typed_ir.big_map.key_type :=
                ty_of_comparable_ty tk;
              Tezos_raw_protocol_alpha.Script_typed_ir.big_map.value_type := tv
              |}, ctxt))
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Big_map_t tk tv _ty_name,
          Tezos_protocol_environment_alpha__Environment.Micheline.Int loc id) =>
        op_gtgteqquestion (Big_map.__exists ctxt id)
          (fun function_parameter =>
            match function_parameter with
            | (_, None) =>
              traced
                (fail
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_big_map
                    loc id))
            | (ctxt, Some (btk, btv)) =>
              Lwt.__return
                (op_gtgtquestion (parse_comparable_ty ctxt (Micheline.root btk))
                  (fun function_parameter =>
                    let '(Ex_comparable_ty btk, ctxt) := function_parameter in
                    op_gtgtquestion
                      (parse_packable_ty ctxt legacy (Micheline.root btv))
                      (fun function_parameter =>
                        let '(Ex_ty btv, ctxt) := function_parameter in
                        op_gtgtquestion (comparable_ty_eq ctxt tk btk)
                          (fun function_parameter =>
                            let 'Eq := function_parameter in
                            op_gtgtquestion (ty_eq ctxt tv btv)
                              (fun function_parameter =>
                                let '(Eq, ctxt) := function_parameter in
                                ok
                                  ({|
                                    Tezos_raw_protocol_alpha.Script_typed_ir.big_map.id :=
                                      Some id;
                                    Tezos_raw_protocol_alpha.Script_typed_ir.big_map.diff :=
                                      empty_map tk;
                                    Tezos_raw_protocol_alpha.Script_typed_ir.big_map.key_type :=
                                      ty_of_comparable_ty tk;
                                    Tezos_raw_protocol_alpha.Script_typed_ir.big_map.value_type :=
                                      tv |}, ctxt))))))
            end)
      | (Tezos_raw_protocol_alpha.Script_typed_ir.Big_map_t _tk _tv _, expr) =>
        traced
          (fail
            (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_kind
              (location expr)
              (cons Tezos_raw_protocol_alpha.Script_tc_errors.Seq_kind
                (cons Tezos_raw_protocol_alpha.Script_tc_errors.Int_kind []))
              (kind expr)))
      end)

with parse_comparable_data {a : Set}
  (type_logger : option type_logger)
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
  (ty : Tezos_raw_protocol_alpha.Script_typed_ir.comparable_ty a)
  (script_data : Tezos_raw_protocol_alpha.Alpha_context.Script.node)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (a * Tezos_raw_protocol_alpha.Alpha_context.context)) :=
  parse_data type_logger ctxt false (ty_of_comparable_ty ty) script_data

with parse_returning {arg ret : Set}
  (type_logger : option type_logger) (tc_context : tc_context)
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context) (legacy : bool)
  (function_parameter :
    Tezos_raw_protocol_alpha.Script_typed_ir.ty arg *
      option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot)
  : Tezos_raw_protocol_alpha.Script_typed_ir.ty ret ->
  Tezos_raw_protocol_alpha.Alpha_context.Script.node ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Script_typed_ir.lambda arg ret *
        Tezos_raw_protocol_alpha.Alpha_context.context)) :=
  let '(arg, arg_annot) := function_parameter in
  fun ret =>
    fun script_instr =>
      op_gtgteqquestion
        (parse_instr type_logger tc_context ctxt legacy script_instr
          (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t arg
            Tezos_raw_protocol_alpha.Script_typed_ir.Empty_t arg_annot))
        (fun function_parameter =>
          match function_parameter with
          |
            (Typed
              ({|
                Tezos_raw_protocol_alpha.Script_typed_ir.descr.loc := loc;
                  Tezos_raw_protocol_alpha.Script_typed_ir.descr.aft :=
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                      ty
                      Tezos_raw_protocol_alpha.Script_typed_ir.Empty_t
                      _) as stack_ty
                  |} as __descr_value), ctxt) =>
            trace_eval
              (fun function_parameter =>
                let 'tt := function_parameter in
                op_gtgteqquestion
                  (Lwt.__return (serialize_ty_for_error ctxt ret))
                  (fun function_parameter =>
                    let '(ret, ctxt) := function_parameter in
                    op_gtgtpipequestion
                      (serialize_stack_for_error ctxt stack_ty)
                      (fun function_parameter =>
                        let '(stack_ty, _ctxt) := function_parameter in
                        Tezos_protocol_environment_alpha__Environment.Error_monad.Bad_return
                          loc stack_ty ret)))
              (op_gtgteqquestion (Lwt.__return (ty_eq ctxt ty ret))
                (fun function_parameter =>
                  let '(Eq, ctxt) := function_parameter in
                  op_gtgteqquestion
                    (Lwt.__return (merge_types legacy ctxt loc ty ret))
                    (fun function_parameter =>
                      let '(_ret, ctxt) := function_parameter in
                      __return
                        ((Tezos_raw_protocol_alpha.Script_typed_ir.Lam
                          __descr_value script_instr), ctxt))))
          |
            (Typed {|
              Tezos_raw_protocol_alpha.Script_typed_ir.descr.loc := loc;
                Tezos_raw_protocol_alpha.Script_typed_ir.descr.aft := stack_ty
                |}, ctxt) =>
            op_gtgteqquestion (Lwt.__return (serialize_ty_for_error ctxt ret))
              (fun function_parameter =>
                let '(ret, ctxt) := function_parameter in
                op_gtgteqquestion (serialize_stack_for_error ctxt stack_ty)
                  (fun function_parameter =>
                    let '(stack_ty, _ctxt) := function_parameter in
                    fail
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.Bad_return
                        loc stack_ty ret)))
          | (Failed {| judgement.Failed.descr := __descr_value |}, ctxt) =>
            __return
              ((Tezos_raw_protocol_alpha.Script_typed_ir.Lam
                (__descr_value
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t ret
                    Tezos_raw_protocol_alpha.Script_typed_ir.Empty_t None))
                script_instr), ctxt)
          end)

with parse_int32
  (n :
    Tezos_protocol_environment_alpha__Environment.Micheline.node
      Tezos_raw_protocol_alpha.Alpha_context.Script.location
      Tezos_raw_protocol_alpha.Alpha_context.Script.prim)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult Z :=
  let error' (function_parameter : unit)
    : Tezos_protocol_environment_alpha__Environment.Error_monad.__error :=
    let 'tt := function_parameter in
    Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_syntactic_constant
      (location n) (strip_locations n)
      (op_caret "a positive 32-bit integer (between 0 and " % string
        (op_caret (Int32.to_string Int32.max_int) ")" % string)) in
  match n with
  | Tezos_protocol_environment_alpha__Environment.Micheline.Int _ n' =>
    (* ❌ Try-with are not handled *)
    try
      (let n'' := Z.to_int n' in
      if op_andand (op_lteq 0 n'') (op_lteq n'' (Int32.to_int Int32.max_int))
        then
        ok n''
      else
        op_atat __error_value (error' tt))
  | _ => op_atat __error_value (error' tt)
  end

with parse_instr {bef : Set}
  (type_logger : option type_logger) (tc_context : tc_context)
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context) (legacy : bool)
  (script_instr : Tezos_raw_protocol_alpha.Alpha_context.Script.node)
  (stack_ty : Tezos_raw_protocol_alpha.Script_typed_ir.stack_ty bef)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (judgement bef * Tezos_raw_protocol_alpha.Alpha_context.context)) :=
  let _check_item {B : Set}
    (check :
    Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult B) (loc :
    Tezos_raw_protocol_alpha.Alpha_context.Script.location) (name :
    Tezos_raw_protocol_alpha.Alpha_context.Script.prim) (n : Z) (m : Z)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult B) :=
    op_atat
      (trace_eval
        (fun function_parameter =>
          let 'tt := function_parameter in
          op_gtgtpipequestion (serialize_stack_for_error ctxt stack_ty)
            (fun function_parameter =>
              let '(stack_ty, _ctxt) := function_parameter in
              Tezos_protocol_environment_alpha__Environment.Error_monad.Bad_stack
                loc name m stack_ty)))
      (op_atat
        (trace
          (Tezos_protocol_environment_alpha__Environment.Error_monad.Bad_stack_item
            n)) (Lwt.__return check)) in
  let check_item_ty {B C : Set}
    (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context) (exp :
    Tezos_raw_protocol_alpha.Script_typed_ir.ty B) (got :
    Tezos_raw_protocol_alpha.Script_typed_ir.ty C) (loc :
    Tezos_raw_protocol_alpha.Alpha_context.Script.location) (name :
    Tezos_raw_protocol_alpha.Alpha_context.Script.prim) (n : Z) (m : Z)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (eq B C * Tezos_raw_protocol_alpha.Script_typed_ir.ty B *
          Tezos_raw_protocol_alpha.Alpha_context.context)) :=
    op_atat
      (trace_eval
        (fun function_parameter =>
          let 'tt := function_parameter in
          op_gtgtpipequestion (serialize_stack_for_error ctxt stack_ty)
            (fun function_parameter =>
              let '(stack_ty, _ctxt) := function_parameter in
              Tezos_protocol_environment_alpha__Environment.Error_monad.Bad_stack
                loc name m stack_ty)))
      (op_atat
        (trace
          (Tezos_protocol_environment_alpha__Environment.Error_monad.Bad_stack_item
            n))
        (Lwt.__return
          (op_gtgtquestion (ty_eq ctxt exp got)
            (fun function_parameter =>
              let '(Eq, ctxt) := function_parameter in
              op_gtgtquestion (merge_types legacy ctxt loc exp got)
                (fun function_parameter =>
                  let '(ty, ctxt) := function_parameter in
                  ok (Eq, ty, ctxt)))))) in
  let check_item_comparable_ty {B C : Set}
    (exp : Tezos_raw_protocol_alpha.Script_typed_ir.comparable_ty B) (got :
    Tezos_raw_protocol_alpha.Script_typed_ir.comparable_ty C) (loc :
    Tezos_raw_protocol_alpha.Alpha_context.Script.location) (name :
    Tezos_raw_protocol_alpha.Alpha_context.Script.prim) (n : Z) (m : Z)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (eq B C * Tezos_raw_protocol_alpha.Script_typed_ir.comparable_ty B)) :=
    op_atat
      (trace_eval
        (fun function_parameter =>
          let 'tt := function_parameter in
          op_gtgtpipequestion (serialize_stack_for_error ctxt stack_ty)
            (fun function_parameter =>
              let '(stack_ty, _ctxt) := function_parameter in
              Tezos_protocol_environment_alpha__Environment.Error_monad.Bad_stack
                loc name m stack_ty)))
      (op_atat
        (trace
          (Tezos_protocol_environment_alpha__Environment.Error_monad.Bad_stack_item
            n))
        (Lwt.__return
          (op_gtgtquestion (comparable_ty_eq ctxt exp got)
            (fun function_parameter =>
              let 'Eq := function_parameter in
              op_gtgtquestion (merge_comparable_types legacy exp got)
                (fun ty => ok (Eq, ty)))))) in
  let log_stack {B C : Set}
    (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context) (loc : Z) (stack_ty
    : Tezos_raw_protocol_alpha.Script_typed_ir.stack_ty B) (aft :
    Tezos_raw_protocol_alpha.Script_typed_ir.stack_ty C)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
    match (type_logger, script_instr) with
    |
      (None, _) |
        (Some _,
          Tezos_protocol_environment_alpha__Environment.Micheline.Seq (-1) _ |
            Tezos_protocol_environment_alpha__Environment.Micheline.Int _ _ |
            Tezos_protocol_environment_alpha__Environment.Micheline.String _ _ |
            Tezos_protocol_environment_alpha__Environment.Micheline.Bytes _ _)
      => return_unit
    |
      (Some log,
        Tezos_protocol_environment_alpha__Environment.Micheline.Prim _ _ _ _ |
          Tezos_protocol_environment_alpha__Environment.Micheline.Seq _ _) =>
      let ctxt := Gas.set_unlimited ctxt in
      op_gtgteqquestion (unparse_stack ctxt stack_ty)
        (fun function_parameter =>
          let '(stack_ty, _) := function_parameter in
          op_gtgteqquestion (unparse_stack ctxt aft)
            (fun function_parameter =>
              let '(aft, _) := function_parameter in
              (* ❌ Sequences of instructions are not handled (operator ";") *)
              let _ := log loc stack_ty aft in
              return_unit))
    end in
  let outer_return := __return in
  let __return
    (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context) (judgement :
    judgement bef)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (judgement bef * Tezos_raw_protocol_alpha.Alpha_context.context)) :=
    match judgement with
    |
      Typed {|
        Tezos_raw_protocol_alpha.Script_typed_ir.descr.loc := loc;
          Tezos_raw_protocol_alpha.Script_typed_ir.descr.aft := aft;
          Tezos_raw_protocol_alpha.Script_typed_ir.descr.instr := instr
          |} =>
      let maximum_type_size := Constants.michelson_maximum_type_size ctxt in
      let type_size :=
        type_size_of_stack_head aft (number_of_generated_growing_types instr) in
      if op_gt type_size maximum_type_size then
        fail
          (Tezos_protocol_environment_alpha__Environment.Error_monad.Type_too_large
            loc type_size maximum_type_size)
      else
        __return (judgement, ctxt)
    | Failed _ => __return (judgement, ctxt)
    end in
  let typed {B : Set}
    (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context) (loc : Z) (instr :
    Tezos_raw_protocol_alpha.Script_typed_ir.instr bef B) (aft :
    Tezos_raw_protocol_alpha.Script_typed_ir.stack_ty B)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (judgement bef * Tezos_raw_protocol_alpha.Alpha_context.context)) :=
    op_gtgteqquestion (log_stack ctxt loc stack_ty aft)
      (fun function_parameter =>
        let 'tt := function_parameter in
        op_gtgteqquestion
          (op_atat Lwt.__return (Gas.consume ctxt (Typecheck_costs.instr instr)))
          (fun ctxt =>
            __return ctxt
              (Typed
                {| Tezos_raw_protocol_alpha.Script_typed_ir.descr.loc := loc;
                  Tezos_raw_protocol_alpha.Script_typed_ir.descr.bef := stack_ty;
                  Tezos_raw_protocol_alpha.Script_typed_ir.descr.aft := aft;
                  Tezos_raw_protocol_alpha.Script_typed_ir.descr.instr := instr
                  |}))) in
  op_gtgteqquestion
    (op_atat Lwt.__return (Gas.consume ctxt Typecheck_costs.cycle))
    (fun ctxt =>
      match (script_instr, stack_ty) with
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_DROP [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t _ rest _) =>
        op_gtgteqquestion (fail_unexpected_annot loc annot)
          (fun function_parameter =>
            let 'tt := function_parameter in
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Drop rest)
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_DROP (cons n [])
          result_annot, whole_stack) =>
        op_gtgteqquestion (Lwt.__return (parse_int32 n))
          (fun whole_n =>
            let fix make_proof_argument {tstk : Set}
              (n : Z) (stk :
              Tezos_raw_protocol_alpha.Script_typed_ir.stack_ty tstk)
              : Tezos_protocol_environment_alpha__Environment.Lwt.t
                (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
                  (dropn_proof_argument tstk)) :=
              match ((op_eq n 0), stk) with
              | (true, rest) =>
                op_atat outer_return
                  (Dropn_proof_argument
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Rest, rest, rest))
              |
                (false,
                  Tezos_raw_protocol_alpha.Script_typed_ir.Item_t v rest annot)
                =>
                op_gtgteqquestion (make_proof_argument (op_minus n 1) rest)
                  (fun function_parameter =>
                    let 'Dropn_proof_argument (n', stack_after_drops, aft') :=
                      function_parameter in
                    op_atat outer_return
                      (Dropn_proof_argument
                        ((Tezos_raw_protocol_alpha.Script_typed_ir.Prefix n'),
                          stack_after_drops,
                          (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t v
                            aft' annot))))
              | (_, _) =>
                op_gtgteqquestion (serialize_stack_for_error ctxt whole_stack)
                  (fun function_parameter =>
                    let '(whole_stack, _ctxt) := function_parameter in
                    fail
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.Bad_stack
                        loc Tezos_raw_protocol_alpha.Alpha_context.Script.I_DROP
                        whole_n whole_stack))
              end in
            op_gtgteqquestion (fail_unexpected_annot loc result_annot)
              (fun function_parameter =>
                let 'tt := function_parameter in
                op_gtgteqquestion (make_proof_argument whole_n whole_stack)
                  (fun function_parameter =>
                    let 'Dropn_proof_argument (n', stack_after_drops, _aft) :=
                      function_parameter in
                    typed ctxt loc
                      (Tezos_raw_protocol_alpha.Script_typed_ir.Dropn whole_n n')
                      stack_after_drops)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_DROP
          ((cons _ (cons _ _)) as l) _, _) =>
        fail
          (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_arity
            loc Tezos_raw_protocol_alpha.Alpha_context.Script.I_DROP 1
            (List.length l))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_DUP [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t v rest stack_annot) =>
        op_gtgteqquestion (parse_var_annot loc (Some stack_annot) annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Dup
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t v
                (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t v rest
                  stack_annot) annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_DIG (cons n [])
          result_annot, stack) =>
        let fix make_proof_argument {tstk : Set}
          (n : Z) (stk : Tezos_raw_protocol_alpha.Script_typed_ir.stack_ty tstk)
          : Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
              (dig_proof_argument tstk)) :=
          match ((op_eq n 0), stk) with
          | (true, Tezos_raw_protocol_alpha.Script_typed_ir.Item_t v rest annot)
            =>
            op_atat outer_return
              (Dig_proof_argument
                (Tezos_raw_protocol_alpha.Script_typed_ir.Rest, (v, annot), rest))
          |
            (false, Tezos_raw_protocol_alpha.Script_typed_ir.Item_t v rest annot)
            =>
            op_gtgteqquestion (make_proof_argument (op_minus n 1) rest)
              (fun function_parameter =>
                let 'Dig_proof_argument (n', (x, xv), aft') :=
                  function_parameter in
                op_atat outer_return
                  (Dig_proof_argument
                    ((Tezos_raw_protocol_alpha.Script_typed_ir.Prefix n'),
                      (x, xv),
                      (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t v aft'
                        annot))))
          | (_, _) =>
            op_gtgteqquestion (serialize_stack_for_error ctxt stack)
              (fun function_parameter =>
                let '(whole_stack, _ctxt) := function_parameter in
                fail
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.Bad_stack
                    loc Tezos_raw_protocol_alpha.Alpha_context.Script.I_DIG 1
                    whole_stack))
          end in
        op_gtgteqquestion (Lwt.__return (parse_int32 n))
          (fun n =>
            op_gtgteqquestion (fail_unexpected_annot loc result_annot)
              (fun function_parameter =>
                let 'tt := function_parameter in
                op_gtgteqquestion (make_proof_argument n stack)
                  (fun function_parameter =>
                    let 'Dig_proof_argument (n', (x, stack_annot), aft) :=
                      function_parameter in
                    typed ctxt loc
                      (Tezos_raw_protocol_alpha.Script_typed_ir.Dig n n')
                      (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t x aft
                        stack_annot))))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_DIG
          (([] | cons _ (cons _ _)) as l) _, _) =>
        fail
          (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_arity
            loc Tezos_raw_protocol_alpha.Alpha_context.Script.I_DIG 1
            (List.length l))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_DUG (cons n [])
          result_annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t x whole_stack
            stack_annot) =>
        op_gtgteqquestion (Lwt.__return (parse_int32 n))
          (fun whole_n =>
            let fix make_proof_argument {tstk x : Set}
              (n : Z) (x : Tezos_raw_protocol_alpha.Script_typed_ir.ty x)
              (stack_annot :
              option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot) (stk :
              Tezos_raw_protocol_alpha.Script_typed_ir.stack_ty tstk)
              : Tezos_protocol_environment_alpha__Environment.Lwt.t
                (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
                  (dug_proof_argument tstk x)) :=
              match ((op_eq n 0), stk) with
              | (true, rest) =>
                op_atat outer_return
                  (Dug_proof_argument
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Rest, tt,
                      (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t x rest
                        stack_annot)))
              |
                (false,
                  Tezos_raw_protocol_alpha.Script_typed_ir.Item_t v rest annot)
                =>
                op_gtgteqquestion
                  (make_proof_argument (op_minus n 1) x stack_annot rest)
                  (fun function_parameter =>
                    let 'Dug_proof_argument (n', tt, aft') := function_parameter
                      in
                    op_atat outer_return
                      (Dug_proof_argument
                        ((Tezos_raw_protocol_alpha.Script_typed_ir.Prefix n'),
                          tt,
                          (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t v
                            aft' annot))))
              | (_, _) =>
                op_gtgteqquestion (serialize_stack_for_error ctxt whole_stack)
                  (fun function_parameter =>
                    let '(whole_stack, _ctxt) := function_parameter in
                    fail
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.Bad_stack
                        loc Tezos_raw_protocol_alpha.Alpha_context.Script.I_DUG
                        whole_n whole_stack))
              end in
            op_gtgteqquestion (fail_unexpected_annot loc result_annot)
              (fun function_parameter =>
                let 'tt := function_parameter in
                op_gtgteqquestion
                  (make_proof_argument whole_n x stack_annot whole_stack)
                  (fun function_parameter =>
                    let 'Dug_proof_argument (n', tt, aft) := function_parameter
                      in
                    typed ctxt loc
                      (Tezos_raw_protocol_alpha.Script_typed_ir.Dug whole_n n')
                      aft)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_DUG (cons _ [])
          result_annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Empty_t as stack) =>
        op_gtgteqquestion (fail_unexpected_annot loc result_annot)
          (fun function_parameter =>
            let 'tt := function_parameter in
            op_gtgteqquestion (serialize_stack_for_error ctxt stack)
              (fun function_parameter =>
                let '(stack, _ctxt) := function_parameter in
                fail
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.Bad_stack
                    loc Tezos_raw_protocol_alpha.Alpha_context.Script.I_DUG 1
                    stack)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_DUG
          (([] | cons _ (cons _ _)) as l) _, _) =>
        fail
          (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_arity
            loc Tezos_raw_protocol_alpha.Alpha_context.Script.I_DUG 1
            (List.length l))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_SWAP [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t v
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t w rest stack_annot)
            cur_top_annot) =>
        op_gtgteqquestion (fail_unexpected_annot loc annot)
          (fun function_parameter =>
            let 'tt := function_parameter in
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Swap
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t w
                (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t v rest
                  cur_top_annot) stack_annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_PUSH
          (cons t (cons d [])) annot, stack) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            op_gtgteqquestion
              (op_atat Lwt.__return (parse_packable_ty ctxt legacy t))
              (fun function_parameter =>
                let '(Ex_ty t, ctxt) := function_parameter in
                op_gtgteqquestion (parse_data type_logger ctxt legacy t d)
                  (fun function_parameter =>
                    let '(v, ctxt) := function_parameter in
                    typed ctxt loc
                      (Tezos_raw_protocol_alpha.Script_typed_ir.Const v)
                      (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t t stack
                        annot))))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_UNIT [] annot, stack)
        =>
        op_gtgteqquestion (parse_var_type_annot loc annot)
          (fun function_parameter =>
            let '(annot, ty_name) := function_parameter in
            typed ctxt loc (Tezos_raw_protocol_alpha.Script_typed_ir.Const tt)
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Unit_t ty_name) stack
                annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_SOME [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t t rest _) =>
        op_gtgteqquestion (parse_var_type_annot loc annot)
          (fun function_parameter =>
            let '(annot, ty_name) := function_parameter in
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Cons_some
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Option_t t ty_name
                  (has_big_map t)) rest annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_NONE (cons t []) annot,
          stack) =>
        op_gtgteqquestion (op_atat Lwt.__return (parse_any_ty ctxt legacy t))
          (fun function_parameter =>
            let '(Ex_ty t, ctxt) := function_parameter in
            op_gtgteqquestion (parse_var_type_annot loc annot)
              (fun function_parameter =>
                let '(annot, ty_name) := function_parameter in
                typed ctxt loc
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Cons_none t)
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Option_t t ty_name
                      (has_big_map t)) stack annot)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_IF_NONE
          (cons bt (cons bf [])) annot,
          (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Option_t t _ _) rest
            option_annot) as bef) =>
        op_gtgteqquestion
          (check_kind
            (cons Tezos_raw_protocol_alpha.Script_tc_errors.Seq_kind []) bt)
          (fun function_parameter =>
            let 'tt := function_parameter in
            op_gtgteqquestion
              (check_kind
                (cons Tezos_raw_protocol_alpha.Script_tc_errors.Seq_kind []) bf)
              (fun function_parameter =>
                let 'tt := function_parameter in
                op_gtgteqquestion (fail_unexpected_annot loc annot)
                  (fun function_parameter =>
                    let 'tt := function_parameter in
                    let annot :=
                      gen_access_annot option_annot None default_some_annot in
                    op_gtgteqquestion
                      (parse_instr type_logger tc_context ctxt legacy bt rest)
                      (fun function_parameter =>
                        let '(btr, ctxt) := function_parameter in
                        op_gtgteqquestion
                          (parse_instr type_logger tc_context ctxt legacy bf
                            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t t
                              rest annot))
                          (fun function_parameter =>
                            let '(bfr, ctxt) := function_parameter in
                            let branch {B : Set}
                              (ibt :
                              Tezos_raw_protocol_alpha.Script_typed_ir.descr
                                op_dollar57 B) (ibf :
                              Tezos_raw_protocol_alpha.Script_typed_ir.descr
                                (op_dollar58 * op_dollar57) B)
                              : Tezos_raw_protocol_alpha.Script_typed_ir.descr
                                (option op_dollar58 * op_dollar57) B :=
                              {|
                                Tezos_raw_protocol_alpha.Script_typed_ir.descr.loc :=
                                  loc;
                                Tezos_raw_protocol_alpha.Script_typed_ir.descr.bef :=
                                  bef;
                                Tezos_raw_protocol_alpha.Script_typed_ir.descr.aft :=
                                  Tezos_raw_protocol_alpha.Script_typed_ir.descr.aft
                                    ibt;
                                Tezos_raw_protocol_alpha.Script_typed_ir.descr.instr :=
                                  Tezos_raw_protocol_alpha.Script_typed_ir.If_none
                                    ibt ibf |} in
                            op_gtgteqquestion
                              (merge_branches legacy ctxt loc btr bfr
                                {| branch.branch := branch |})
                              (fun function_parameter =>
                                let '(judgement, ctxt) := function_parameter in
                                __return ctxt judgement))))))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_PAIR [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t a
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t b rest snd_annot)
            fst_annot) =>
        op_gtgteqquestion
          (parse_constr_annot loc (Some (var_to_field_annot fst_annot))
            (Some (var_to_field_annot snd_annot)) annot)
          (fun function_parameter =>
            let '(annot, ty_name, l_field, r_field) := function_parameter in
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Cons_pair
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t
                  (a, l_field, fst_annot) (b, r_field, snd_annot) ty_name
                  (op_pipepipe (has_big_map a) (has_big_map b))) rest annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_CAR [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t
              (a, expected_field_annot, a_annot) _ _ _) rest pair_annot) =>
        op_gtgteqquestion
          (parse_destr_annot loc annot default_car_annot expected_field_annot
            pair_annot a_annot)
          (fun function_parameter =>
            let '(annot, field_annot) := function_parameter in
            op_gtgteqquestion
              (op_atat Lwt.__return
                (check_correct_field field_annot expected_field_annot))
              (fun function_parameter =>
                let 'tt := function_parameter in
                typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Car
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t a rest annot)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_CDR [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t _
              (b, expected_field_annot, b_annot) _ _) rest pair_annot) =>
        op_gtgteqquestion
          (parse_destr_annot loc annot default_cdr_annot expected_field_annot
            pair_annot b_annot)
          (fun function_parameter =>
            let '(annot, field_annot) := function_parameter in
            op_gtgteqquestion
              (op_atat Lwt.__return
                (check_correct_field field_annot expected_field_annot))
              (fun function_parameter =>
                let 'tt := function_parameter in
                typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Cdr
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t b rest annot)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_LEFT (cons tr [])
          annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t tl rest stack_annot)
        =>
        op_gtgteqquestion (op_atat Lwt.__return (parse_any_ty ctxt legacy tr))
          (fun function_parameter =>
            let '(Ex_ty tr, ctxt) := function_parameter in
            op_gtgteqquestion
              (parse_constr_annot loc (Some (var_to_field_annot stack_annot))
                None annot)
              (fun function_parameter =>
                let '(annot, tname, l_field, r_field) := function_parameter in
                typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Left
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Union_t
                      (tl, l_field) (tr, r_field) tname
                      (op_pipepipe (has_big_map tl) (has_big_map tr))) rest
                    annot)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_RIGHT (cons tl [])
          annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t tr rest stack_annot)
        =>
        op_gtgteqquestion (op_atat Lwt.__return (parse_any_ty ctxt legacy tl))
          (fun function_parameter =>
            let '(Ex_ty tl, ctxt) := function_parameter in
            op_gtgteqquestion
              (parse_constr_annot loc None
                (Some (var_to_field_annot stack_annot)) annot)
              (fun function_parameter =>
                let '(annot, tname, l_field, r_field) := function_parameter in
                typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Right
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Union_t
                      (tl, l_field) (tr, r_field) tname
                      (op_pipepipe (has_big_map tl) (has_big_map tr))) rest
                    annot)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_IF_LEFT
          (cons bt (cons bf [])) annot,
          (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Union_t (tl, l_field)
              (tr, r_field) _ _) rest union_annot) as bef) =>
        op_gtgteqquestion
          (check_kind
            (cons Tezos_raw_protocol_alpha.Script_tc_errors.Seq_kind []) bt)
          (fun function_parameter =>
            let 'tt := function_parameter in
            op_gtgteqquestion
              (check_kind
                (cons Tezos_raw_protocol_alpha.Script_tc_errors.Seq_kind []) bf)
              (fun function_parameter =>
                let 'tt := function_parameter in
                op_gtgteqquestion (fail_unexpected_annot loc annot)
                  (fun function_parameter =>
                    let 'tt := function_parameter in
                    let left_annot :=
                      gen_access_annot union_annot (Some default_left_annot)
                        l_field in
                    let right_annot :=
                      gen_access_annot union_annot (Some default_right_annot)
                        r_field in
                    op_gtgteqquestion
                      (parse_instr type_logger tc_context ctxt legacy bt
                        (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t tl rest
                          left_annot))
                      (fun function_parameter =>
                        let '(btr, ctxt) := function_parameter in
                        op_gtgteqquestion
                          (parse_instr type_logger tc_context ctxt legacy bf
                            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t tr
                              rest right_annot))
                          (fun function_parameter =>
                            let '(bfr, ctxt) := function_parameter in
                            let branch {B : Set}
                              (ibt :
                              Tezos_raw_protocol_alpha.Script_typed_ir.descr
                                (op_dollar77 * op_dollar76) B) (ibf :
                              Tezos_raw_protocol_alpha.Script_typed_ir.descr
                                (op_dollar78 * op_dollar76) B)
                              : Tezos_raw_protocol_alpha.Script_typed_ir.descr
                                (Tezos_raw_protocol_alpha.Script_typed_ir.union
                                  op_dollar77 op_dollar78 * op_dollar76) B :=
                              {|
                                Tezos_raw_protocol_alpha.Script_typed_ir.descr.loc :=
                                  loc;
                                Tezos_raw_protocol_alpha.Script_typed_ir.descr.bef :=
                                  bef;
                                Tezos_raw_protocol_alpha.Script_typed_ir.descr.aft :=
                                  Tezos_raw_protocol_alpha.Script_typed_ir.descr.aft
                                    ibt;
                                Tezos_raw_protocol_alpha.Script_typed_ir.descr.instr :=
                                  Tezos_raw_protocol_alpha.Script_typed_ir.If_left
                                    ibt ibf |} in
                            op_gtgteqquestion
                              (merge_branches legacy ctxt loc btr bfr
                                {| branch.branch := branch |})
                              (fun function_parameter =>
                                let '(judgement, ctxt) := function_parameter in
                                __return ctxt judgement))))))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_NIL (cons t []) annot,
          stack) =>
        op_gtgteqquestion (op_atat Lwt.__return (parse_any_ty ctxt legacy t))
          (fun function_parameter =>
            let '(Ex_ty t, ctxt) := function_parameter in
            op_gtgteqquestion (parse_var_type_annot loc annot)
              (fun function_parameter =>
                let '(annot, ty_name) := function_parameter in
                typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Nil
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                    (Tezos_raw_protocol_alpha.Script_typed_ir.List_t t ty_name
                      (has_big_map t)) stack annot)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_CONS [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t tv
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.List_t t ty_name
                has_big_map) rest _) _) =>
        op_gtgteqquestion
          (check_item_ty ctxt tv t loc
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_CONS 1 2)
          (fun function_parameter =>
            let '(Eq, t, ctxt) := function_parameter in
            op_gtgteqquestion (parse_var_annot loc None annot)
              (fun annot =>
                typed ctxt loc
                  Tezos_raw_protocol_alpha.Script_typed_ir.Cons_list
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                    (Tezos_raw_protocol_alpha.Script_typed_ir.List_t t ty_name
                      has_big_map) rest annot)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_IF_CONS
          (cons bt (cons bf [])) annot,
          (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.List_t t ty_name
              has_big_map) rest list_annot) as bef) =>
        op_gtgteqquestion
          (check_kind
            (cons Tezos_raw_protocol_alpha.Script_tc_errors.Seq_kind []) bt)
          (fun function_parameter =>
            let 'tt := function_parameter in
            op_gtgteqquestion
              (check_kind
                (cons Tezos_raw_protocol_alpha.Script_tc_errors.Seq_kind []) bf)
              (fun function_parameter =>
                let 'tt := function_parameter in
                op_gtgteqquestion (fail_unexpected_annot loc annot)
                  (fun function_parameter =>
                    let 'tt := function_parameter in
                    let hd_annot :=
                      gen_access_annot list_annot None default_hd_annot in
                    let tl_annot :=
                      gen_access_annot list_annot None default_tl_annot in
                    op_gtgteqquestion
                      (parse_instr type_logger tc_context ctxt legacy bt
                        (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t t
                          (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                            (Tezos_raw_protocol_alpha.Script_typed_ir.List_t t
                              ty_name has_big_map) rest tl_annot) hd_annot))
                      (fun function_parameter =>
                        let '(btr, ctxt) := function_parameter in
                        op_gtgteqquestion
                          (parse_instr type_logger tc_context ctxt legacy bf
                            rest)
                          (fun function_parameter =>
                            let '(bfr, ctxt) := function_parameter in
                            let branch {B : Set}
                              (ibt :
                              Tezos_raw_protocol_alpha.Script_typed_ir.descr
                                (op_dollar86 * (list op_dollar86 * op_dollar85))
                                B) (ibf :
                              Tezos_raw_protocol_alpha.Script_typed_ir.descr
                                op_dollar85 B)
                              : Tezos_raw_protocol_alpha.Script_typed_ir.descr
                                (list op_dollar86 * op_dollar85) B :=
                              {|
                                Tezos_raw_protocol_alpha.Script_typed_ir.descr.loc :=
                                  loc;
                                Tezos_raw_protocol_alpha.Script_typed_ir.descr.bef :=
                                  bef;
                                Tezos_raw_protocol_alpha.Script_typed_ir.descr.aft :=
                                  Tezos_raw_protocol_alpha.Script_typed_ir.descr.aft
                                    ibt;
                                Tezos_raw_protocol_alpha.Script_typed_ir.descr.instr :=
                                  Tezos_raw_protocol_alpha.Script_typed_ir.If_cons
                                    ibt ibf |} in
                            op_gtgteqquestion
                              (merge_branches legacy ctxt loc btr bfr
                                {| branch.branch := branch |})
                              (fun function_parameter =>
                                let '(judgement, ctxt) := function_parameter in
                                __return ctxt judgement))))))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_SIZE [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.List_t _ _ _) rest _) =>
        op_gtgteqquestion (parse_var_type_annot loc annot)
          (fun function_parameter =>
            let '(annot, tname) := function_parameter in
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.List_size
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t tname) rest
                annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_MAP (cons body [])
          annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.List_t elt _ _)
            starting_rest list_annot) =>
        op_gtgteqquestion
          (check_kind
            (cons Tezos_raw_protocol_alpha.Script_tc_errors.Seq_kind []) body)
          (fun function_parameter =>
            let 'tt := function_parameter in
            op_gtgteqquestion (parse_var_type_annot loc annot)
              (fun function_parameter =>
                let '(ret_annot, list_ty_name) := function_parameter in
                let elt_annot :=
                  gen_access_annot list_annot None default_elt_annot in
                op_gtgteqquestion
                  (parse_instr type_logger tc_context ctxt legacy body
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t elt
                      starting_rest elt_annot))
                  (fun function_parameter =>
                    let '(judgement, ctxt) := function_parameter in
                    match judgement with
                    |
                      Typed
                        ({|
                          Tezos_raw_protocol_alpha.Script_typed_ir.descr.aft :=
                            Tezos_raw_protocol_alpha.Script_typed_ir.Item_t ret
                              rest _
                            |} as ibody) =>
                      let invalid_map_body (function_parameter : unit)
                        : Tezos_protocol_environment_alpha__Environment.Lwt.t
                          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
                            Tezos_protocol_environment_alpha__Environment.Error_monad.__error) :=
                        let 'tt := function_parameter in
                        op_gtgtpipequestion
                          (serialize_stack_for_error ctxt
                            (Tezos_raw_protocol_alpha.Script_typed_ir.descr.aft
                              ibody))
                          (fun function_parameter =>
                            let '(aft, _ctxt) := function_parameter in
                            Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_map_body
                              loc aft) in
                      trace_eval invalid_map_body
                        (op_gtgteqquestion
                          (op_atat Lwt.__return
                            (stack_ty_eq ctxt 1 rest starting_rest))
                          (fun function_parameter =>
                            let '(Eq, ctxt) := function_parameter in
                            op_gtgteqquestion
                              (op_atat Lwt.__return
                                (merge_stacks legacy loc ctxt rest starting_rest))
                              (fun function_parameter =>
                                let '(rest, ctxt) := function_parameter in
                                typed ctxt loc
                                  (Tezos_raw_protocol_alpha.Script_typed_ir.List_map
                                    ibody)
                                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                                    (Tezos_raw_protocol_alpha.Script_typed_ir.List_t
                                      ret list_ty_name (has_big_map ret)) rest
                                    ret_annot))))
                    |
                      Typed {|
                        Tezos_raw_protocol_alpha.Script_typed_ir.descr.aft := aft
                          |} =>
                      op_gtgteqquestion (serialize_stack_for_error ctxt aft)
                        (fun function_parameter =>
                          let '(aft, _ctxt) := function_parameter in
                          fail
                            (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_map_body
                              loc aft))
                    | Failed _ =>
                      fail
                        (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_map_block_fail
                          loc)
                    end)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_ITER (cons body [])
          annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.List_t elt _ _) rest
            list_annot) =>
        op_gtgteqquestion
          (check_kind
            (cons Tezos_raw_protocol_alpha.Script_tc_errors.Seq_kind []) body)
          (fun function_parameter =>
            let 'tt := function_parameter in
            op_gtgteqquestion (fail_unexpected_annot loc annot)
              (fun function_parameter =>
                let 'tt := function_parameter in
                let elt_annot :=
                  gen_access_annot list_annot None default_elt_annot in
                op_gtgteqquestion
                  (parse_instr type_logger tc_context ctxt legacy body
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t elt rest
                      elt_annot))
                  (fun function_parameter =>
                    let '(judgement, ctxt) := function_parameter in
                    match judgement with
                    |
                      Typed
                        ({|
                          Tezos_raw_protocol_alpha.Script_typed_ir.descr.aft := aft
                            |} as ibody) =>
                      let invalid_iter_body (function_parameter : unit)
                        : Tezos_protocol_environment_alpha__Environment.Lwt.t
                          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
                            Tezos_protocol_environment_alpha__Environment.Error_monad.__error) :=
                        let 'tt := function_parameter in
                        op_gtgteqquestion
                          (serialize_stack_for_error ctxt
                            (Tezos_raw_protocol_alpha.Script_typed_ir.descr.aft
                              ibody))
                          (fun function_parameter =>
                            let '(aft, ctxt) := function_parameter in
                            op_gtgtpipequestion
                              (serialize_stack_for_error ctxt rest)
                              (fun function_parameter =>
                                let '(rest, _ctxt) := function_parameter in
                                Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_iter_body
                                  loc rest aft)) in
                      trace_eval invalid_iter_body
                        (op_gtgteqquestion
                          (op_atat Lwt.__return (stack_ty_eq ctxt 1 aft rest))
                          (fun function_parameter =>
                            let '(Eq, ctxt) := function_parameter in
                            op_gtgteqquestion
                              (op_atat Lwt.__return
                                (merge_stacks legacy loc ctxt aft rest))
                              (fun function_parameter =>
                                let '(rest, ctxt) := function_parameter in
                                typed ctxt loc
                                  (Tezos_raw_protocol_alpha.Script_typed_ir.List_iter
                                    ibody) rest)))
                    | Failed {| judgement.Failed.descr := __descr_value |} =>
                      typed ctxt loc
                        (Tezos_raw_protocol_alpha.Script_typed_ir.List_iter
                          (__descr_value rest)) rest
                    end)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_EMPTY_SET (cons t [])
          annot, rest) =>
        op_gtgteqquestion (op_atat Lwt.__return (parse_comparable_ty ctxt t))
          (fun function_parameter =>
            let '(Ex_comparable_ty t, ctxt) := function_parameter in
            op_gtgteqquestion (parse_var_type_annot loc annot)
              (fun function_parameter =>
                let '(annot, tname) := function_parameter in
                typed ctxt loc
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Empty_set t)
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Set_t t tname)
                    rest annot)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_ITER (cons body [])
          annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Set_t comp_elt _) rest
            set_annot) =>
        op_gtgteqquestion
          (check_kind
            (cons Tezos_raw_protocol_alpha.Script_tc_errors.Seq_kind []) body)
          (fun function_parameter =>
            let 'tt := function_parameter in
            op_gtgteqquestion (fail_unexpected_annot loc annot)
              (fun function_parameter =>
                let 'tt := function_parameter in
                let elt_annot :=
                  gen_access_annot set_annot None default_elt_annot in
                let elt := ty_of_comparable_ty comp_elt in
                op_gtgteqquestion
                  (parse_instr type_logger tc_context ctxt legacy body
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t elt rest
                      elt_annot))
                  (fun function_parameter =>
                    let '(judgement, ctxt) := function_parameter in
                    match judgement with
                    |
                      Typed
                        ({|
                          Tezos_raw_protocol_alpha.Script_typed_ir.descr.aft := aft
                            |} as ibody) =>
                      let invalid_iter_body (function_parameter : unit)
                        : Tezos_protocol_environment_alpha__Environment.Lwt.t
                          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
                            Tezos_protocol_environment_alpha__Environment.Error_monad.__error) :=
                        let 'tt := function_parameter in
                        op_gtgteqquestion
                          (serialize_stack_for_error ctxt
                            (Tezos_raw_protocol_alpha.Script_typed_ir.descr.aft
                              ibody))
                          (fun function_parameter =>
                            let '(aft, ctxt) := function_parameter in
                            op_gtgtpipequestion
                              (serialize_stack_for_error ctxt rest)
                              (fun function_parameter =>
                                let '(rest, _ctxt) := function_parameter in
                                Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_iter_body
                                  loc rest aft)) in
                      trace_eval invalid_iter_body
                        (op_gtgteqquestion
                          (op_atat Lwt.__return (stack_ty_eq ctxt 1 aft rest))
                          (fun function_parameter =>
                            let '(Eq, ctxt) := function_parameter in
                            op_gtgteqquestion
                              (op_atat Lwt.__return
                                (merge_stacks legacy loc ctxt aft rest))
                              (fun function_parameter =>
                                let '(rest, ctxt) := function_parameter in
                                typed ctxt loc
                                  (Tezos_raw_protocol_alpha.Script_typed_ir.Set_iter
                                    ibody) rest)))
                    | Failed {| judgement.Failed.descr := __descr_value |} =>
                      typed ctxt loc
                        (Tezos_raw_protocol_alpha.Script_typed_ir.Set_iter
                          (__descr_value rest)) rest
                    end)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_MEM [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t v
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Set_t elt _) rest _) _)
        =>
        let elt := ty_of_comparable_ty elt in
        op_gtgteqquestion (parse_var_type_annot loc annot)
          (fun function_parameter =>
            let '(annot, tname) := function_parameter in
            op_gtgteqquestion
              (check_item_ty ctxt elt v loc
                Tezos_raw_protocol_alpha.Alpha_context.Script.I_MEM 1 2)
              (fun function_parameter =>
                let '(Eq, _, ctxt) := function_parameter in
                typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Set_mem
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t tname) rest
                    annot)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_UPDATE [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t v
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t _)
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Set_t elt tname) rest
                set_annot) _) _) =>
        match comparable_ty_of_ty v with
        | None =>
          op_gtgteqquestion (unparse_ty ctxt v)
            (fun function_parameter =>
              let '(v, _ctxt) := function_parameter in
              fail
                (Tezos_protocol_environment_alpha__Environment.Error_monad.Comparable_type_expected
                  loc (Micheline.strip_locations v)))
        | Some v =>
          op_gtgteqquestion (parse_var_annot loc (Some set_annot) annot)
            (fun annot =>
              op_gtgteqquestion
                (check_item_comparable_ty elt v loc
                  Tezos_raw_protocol_alpha.Alpha_context.Script.I_UPDATE 1 3)
                (fun function_parameter =>
                  let '(Eq, elt) := function_parameter in
                  typed ctxt loc
                    Tezos_raw_protocol_alpha.Script_typed_ir.Set_update
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                      (Tezos_raw_protocol_alpha.Script_typed_ir.Set_t elt tname)
                      rest annot)))
        end
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_SIZE [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Set_t _ _) rest _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Set_size
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t None) rest annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_EMPTY_MAP
          (cons tk (cons tv [])) annot, stack) =>
        op_gtgteqquestion (op_atat Lwt.__return (parse_comparable_ty ctxt tk))
          (fun function_parameter =>
            let '(Ex_comparable_ty tk, ctxt) := function_parameter in
            op_gtgteqquestion
              (op_atat Lwt.__return (parse_any_ty ctxt legacy tv))
              (fun function_parameter =>
                let '(Ex_ty tv, ctxt) := function_parameter in
                op_gtgteqquestion (parse_var_type_annot loc annot)
                  (fun function_parameter =>
                    let '(annot, ty_name) := function_parameter in
                    typed ctxt loc
                      (Tezos_raw_protocol_alpha.Script_typed_ir.Empty_map tk tv)
                      (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                        (Tezos_raw_protocol_alpha.Script_typed_ir.Map_t tk tv
                          ty_name (has_big_map tv)) stack annot))))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_MAP (cons body [])
          annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Map_t ck elt _ _)
            starting_rest _map_annot) =>
        let k := ty_of_comparable_ty ck in
        op_gtgteqquestion
          (check_kind
            (cons Tezos_raw_protocol_alpha.Script_tc_errors.Seq_kind []) body)
          (fun function_parameter =>
            let 'tt := function_parameter in
            op_gtgteqquestion (parse_var_type_annot loc annot)
              (fun function_parameter =>
                let '(ret_annot, ty_name) := function_parameter in
                let k_name := field_to_var_annot default_key_annot in
                let e_name := field_to_var_annot default_elt_annot in
                op_gtgteqquestion
                  (parse_instr type_logger tc_context ctxt legacy body
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                      (Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t
                        (k, None, k_name) (elt, None, e_name) None
                        (has_big_map elt)) starting_rest None))
                  (fun function_parameter =>
                    let '(judgement, ctxt) := function_parameter in
                    match judgement with
                    |
                      Typed
                        ({|
                          Tezos_raw_protocol_alpha.Script_typed_ir.descr.aft :=
                            Tezos_raw_protocol_alpha.Script_typed_ir.Item_t ret
                              rest _
                            |} as ibody) =>
                      let invalid_map_body (function_parameter : unit)
                        : Tezos_protocol_environment_alpha__Environment.Lwt.t
                          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
                            Tezos_protocol_environment_alpha__Environment.Error_monad.__error) :=
                        let 'tt := function_parameter in
                        op_gtgtpipequestion
                          (serialize_stack_for_error ctxt
                            (Tezos_raw_protocol_alpha.Script_typed_ir.descr.aft
                              ibody))
                          (fun function_parameter =>
                            let '(aft, _ctxt) := function_parameter in
                            Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_map_body
                              loc aft) in
                      trace_eval invalid_map_body
                        (op_gtgteqquestion
                          (op_atat Lwt.__return
                            (stack_ty_eq ctxt 1 rest starting_rest))
                          (fun function_parameter =>
                            let '(Eq, ctxt) := function_parameter in
                            op_gtgteqquestion
                              (op_atat Lwt.__return
                                (merge_stacks legacy loc ctxt rest starting_rest))
                              (fun function_parameter =>
                                let '(rest, ctxt) := function_parameter in
                                typed ctxt loc
                                  (Tezos_raw_protocol_alpha.Script_typed_ir.Map_map
                                    ibody)
                                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                                    (Tezos_raw_protocol_alpha.Script_typed_ir.Map_t
                                      ck ret ty_name (has_big_map ret)) rest
                                    ret_annot))))
                    |
                      Typed {|
                        Tezos_raw_protocol_alpha.Script_typed_ir.descr.aft := aft
                          |} =>
                      op_gtgteqquestion (serialize_stack_for_error ctxt aft)
                        (fun function_parameter =>
                          let '(aft, _ctxt) := function_parameter in
                          fail
                            (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_map_body
                              loc aft))
                    | Failed _ =>
                      fail
                        (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_map_block_fail
                          loc)
                    end)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_ITER (cons body [])
          annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Map_t comp_elt element_ty
              _ _) rest _map_annot) =>
        op_gtgteqquestion
          (check_kind
            (cons Tezos_raw_protocol_alpha.Script_tc_errors.Seq_kind []) body)
          (fun function_parameter =>
            let 'tt := function_parameter in
            op_gtgteqquestion (fail_unexpected_annot loc annot)
              (fun function_parameter =>
                let 'tt := function_parameter in
                let k_name := field_to_var_annot default_key_annot in
                let e_name := field_to_var_annot default_elt_annot in
                let key := ty_of_comparable_ty comp_elt in
                op_gtgteqquestion
                  (parse_instr type_logger tc_context ctxt legacy body
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                      (Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t
                        (key, None, k_name) (element_ty, None, e_name) None
                        (has_big_map element_ty)) rest None))
                  (fun function_parameter =>
                    let '(judgement, ctxt) := function_parameter in
                    match judgement with
                    |
                      Typed
                        ({|
                          Tezos_raw_protocol_alpha.Script_typed_ir.descr.aft := aft
                            |} as ibody) =>
                      let invalid_iter_body (function_parameter : unit)
                        : Tezos_protocol_environment_alpha__Environment.Lwt.t
                          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
                            Tezos_protocol_environment_alpha__Environment.Error_monad.__error) :=
                        let 'tt := function_parameter in
                        op_gtgteqquestion
                          (serialize_stack_for_error ctxt
                            (Tezos_raw_protocol_alpha.Script_typed_ir.descr.aft
                              ibody))
                          (fun function_parameter =>
                            let '(aft, ctxt) := function_parameter in
                            op_gtgtpipequestion
                              (serialize_stack_for_error ctxt rest)
                              (fun function_parameter =>
                                let '(rest, _ctxt) := function_parameter in
                                Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_iter_body
                                  loc rest aft)) in
                      trace_eval invalid_iter_body
                        (op_gtgteqquestion
                          (op_atat Lwt.__return (stack_ty_eq ctxt 1 aft rest))
                          (fun function_parameter =>
                            let '(Eq, ctxt) := function_parameter in
                            op_gtgteqquestion
                              (op_atat Lwt.__return
                                (merge_stacks legacy loc ctxt aft rest))
                              (fun function_parameter =>
                                let '(rest, ctxt) := function_parameter in
                                typed ctxt loc
                                  (Tezos_raw_protocol_alpha.Script_typed_ir.Map_iter
                                    ibody) rest)))
                    | Failed {| judgement.Failed.descr := __descr_value |} =>
                      typed ctxt loc
                        (Tezos_raw_protocol_alpha.Script_typed_ir.Map_iter
                          (__descr_value rest)) rest
                    end)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_MEM [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t vk
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Map_t ck _ _ _) rest _)
            _) =>
        let k := ty_of_comparable_ty ck in
        op_gtgteqquestion
          (check_item_ty ctxt vk k loc
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_MEM 1 2)
          (fun function_parameter =>
            let '(Eq, _, ctxt) := function_parameter in
            op_gtgteqquestion (parse_var_annot loc None annot)
              (fun annot =>
                typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Map_mem
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t None) rest
                    annot)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_GET [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t vk
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Map_t ck elt _
                has_big_map) rest _) _) =>
        let k := ty_of_comparable_ty ck in
        op_gtgteqquestion
          (check_item_ty ctxt vk k loc
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_GET 1 2)
          (fun function_parameter =>
            let '(Eq, _, ctxt) := function_parameter in
            op_gtgteqquestion (parse_var_annot loc None annot)
              (fun annot =>
                typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Map_get
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Option_t elt None
                      has_big_map) rest annot)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_UPDATE [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t vk
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Option_t vv _ _)
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Map_t ck v map_name
                  has_big_map) rest map_annot) _) _) =>
        let k := ty_of_comparable_ty ck in
        op_gtgteqquestion
          (check_item_ty ctxt vk k loc
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_UPDATE 1 3)
          (fun function_parameter =>
            let '(Eq, _, ctxt) := function_parameter in
            op_gtgteqquestion
              (check_item_ty ctxt vv v loc
                Tezos_raw_protocol_alpha.Alpha_context.Script.I_UPDATE 2 3)
              (fun function_parameter =>
                let '(Eq, v, ctxt) := function_parameter in
                op_gtgteqquestion (parse_var_annot loc (Some map_annot) annot)
                  (fun annot =>
                    typed ctxt loc
                      Tezos_raw_protocol_alpha.Script_typed_ir.Map_update
                      (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                        (Tezos_raw_protocol_alpha.Script_typed_ir.Map_t ck v
                          map_name has_big_map) rest annot))))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_SIZE [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Map_t _ _ _ _) rest _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Map_size
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t None) rest annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_EMPTY_BIG_MAP
          (cons tk (cons tv [])) annot, stack) =>
        op_gtgteqquestion (op_atat Lwt.__return (parse_comparable_ty ctxt tk))
          (fun function_parameter =>
            let '(Ex_comparable_ty tk, ctxt) := function_parameter in
            op_gtgteqquestion
              (op_atat Lwt.__return (parse_packable_ty ctxt legacy tv))
              (fun function_parameter =>
                let '(Ex_ty tv, ctxt) := function_parameter in
                op_gtgteqquestion (parse_var_type_annot loc annot)
                  (fun function_parameter =>
                    let '(annot, ty_name) := function_parameter in
                    typed ctxt loc
                      (Tezos_raw_protocol_alpha.Script_typed_ir.Empty_big_map tk
                        tv)
                      (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                        (Tezos_raw_protocol_alpha.Script_typed_ir.Big_map_t tk
                          tv ty_name) stack annot))))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_MEM [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t set_key
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Big_map_t map_key _ _)
              rest _) _) =>
        let k := ty_of_comparable_ty map_key in
        op_gtgteqquestion
          (check_item_ty ctxt set_key k loc
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_MEM 1 2)
          (fun function_parameter =>
            let '(Eq, _, ctxt) := function_parameter in
            op_gtgteqquestion (parse_var_annot loc None annot)
              (fun annot =>
                typed ctxt loc
                  Tezos_raw_protocol_alpha.Script_typed_ir.Big_map_mem
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t None) rest
                    annot)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_GET [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t vk
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Big_map_t ck elt _) rest
              _) _) =>
        let k := ty_of_comparable_ty ck in
        op_gtgteqquestion
          (check_item_ty ctxt vk k loc
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_GET 1 2)
          (fun function_parameter =>
            let '(Eq, _, ctxt) := function_parameter in
            op_gtgteqquestion (parse_var_annot loc None annot)
              (fun annot =>
                typed ctxt loc
                  Tezos_raw_protocol_alpha.Script_typed_ir.Big_map_get
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Option_t elt None
                      (has_big_map elt)) rest annot)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_UPDATE [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t set_key
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Option_t set_value _ _)
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Big_map_t map_key
                  map_value map_name) rest map_annot) _) _) =>
        let k := ty_of_comparable_ty map_key in
        op_gtgteqquestion
          (check_item_ty ctxt set_key k loc
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_UPDATE 1 3)
          (fun function_parameter =>
            let '(Eq, _, ctxt) := function_parameter in
            op_gtgteqquestion
              (check_item_ty ctxt set_value map_value loc
                Tezos_raw_protocol_alpha.Alpha_context.Script.I_UPDATE 2 3)
              (fun function_parameter =>
                let '(Eq, map_value, ctxt) := function_parameter in
                op_gtgteqquestion (parse_var_annot loc (Some map_annot) annot)
                  (fun annot =>
                    typed ctxt loc
                      Tezos_raw_protocol_alpha.Script_typed_ir.Big_map_update
                      (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                        (Tezos_raw_protocol_alpha.Script_typed_ir.Big_map_t
                          map_key map_value map_name) rest annot))))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Seq loc [],
          stack) =>
        typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Nop stack
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Seq loc
          (cons single []), stack) =>
        op_gtgteqquestion
          (parse_instr type_logger tc_context ctxt legacy single stack)
          (fun function_parameter =>
            let '(judgement, ctxt) := function_parameter in
            match judgement with
            |
              Typed
                ({| Tezos_raw_protocol_alpha.Script_typed_ir.descr.aft := aft |}
                  as instr) =>
              let nop :=
                {| Tezos_raw_protocol_alpha.Script_typed_ir.descr.loc := loc;
                  Tezos_raw_protocol_alpha.Script_typed_ir.descr.bef := aft;
                  Tezos_raw_protocol_alpha.Script_typed_ir.descr.aft := aft;
                  Tezos_raw_protocol_alpha.Script_typed_ir.descr.instr :=
                    Tezos_raw_protocol_alpha.Script_typed_ir.Nop |} in
              typed ctxt loc
                (Tezos_raw_protocol_alpha.Script_typed_ir.Seq instr nop) aft
            | Failed {| judgement.Failed.descr := __descr_value |} =>
              let __descr_value {B : Set}
                (aft : Tezos_raw_protocol_alpha.Script_typed_ir.stack_ty B)
                : Tezos_raw_protocol_alpha.Script_typed_ir.descr bef B :=
                let nop :=
                  {| Tezos_raw_protocol_alpha.Script_typed_ir.descr.loc := loc;
                    Tezos_raw_protocol_alpha.Script_typed_ir.descr.bef := aft;
                    Tezos_raw_protocol_alpha.Script_typed_ir.descr.aft := aft;
                    Tezos_raw_protocol_alpha.Script_typed_ir.descr.instr :=
                      Tezos_raw_protocol_alpha.Script_typed_ir.Nop |} in
                let __descr_value := __descr_value aft in
                (* ❌ Record substitution not handled *)
                record_substitution in
              __return ctxt
                (Failed {| judgement.Failed.descr := __descr_value |})
            end)
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Seq loc
          (cons hd tl), stack) =>
        op_gtgteqquestion
          (parse_instr type_logger tc_context ctxt legacy hd stack)
          (fun function_parameter =>
            let '(judgement, ctxt) := function_parameter in
            match judgement with
            | Failed _ =>
              fail
                (Tezos_protocol_environment_alpha__Environment.Error_monad.Fail_not_in_tail_position
                  (Micheline.location hd))
            |
              Typed
                ({|
                  Tezos_raw_protocol_alpha.Script_typed_ir.descr.aft := middle
                    |} as ihd) =>
              op_gtgteqquestion
                (parse_instr type_logger tc_context ctxt legacy
                  (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                    (-1) tl) middle)
                (fun function_parameter =>
                  let '(judgement, ctxt) := function_parameter in
                  match judgement with
                  | Failed {| judgement.Failed.descr := __descr_value |} =>
                    let __descr_value {B : Set}
                      (ret :
                      Tezos_raw_protocol_alpha.Script_typed_ir.stack_ty B)
                      : Tezos_raw_protocol_alpha.Script_typed_ir.descr bef B :=
                      {|
                        Tezos_raw_protocol_alpha.Script_typed_ir.descr.loc :=
                          loc;
                        Tezos_raw_protocol_alpha.Script_typed_ir.descr.bef :=
                          stack;
                        Tezos_raw_protocol_alpha.Script_typed_ir.descr.aft :=
                          ret;
                        Tezos_raw_protocol_alpha.Script_typed_ir.descr.instr :=
                          Tezos_raw_protocol_alpha.Script_typed_ir.Seq ihd
                            (__descr_value ret) |} in
                    __return ctxt
                      (Failed {| judgement.Failed.descr := __descr_value |})
                  | Typed itl =>
                    typed ctxt loc
                      (Tezos_raw_protocol_alpha.Script_typed_ir.Seq ihd itl)
                      (Tezos_raw_protocol_alpha.Script_typed_ir.descr.aft itl)
                  end)
            end)
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_IF
          (cons bt (cons bf [])) annot,
          (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t _) rest _) as bef)
        =>
        op_gtgteqquestion
          (check_kind
            (cons Tezos_raw_protocol_alpha.Script_tc_errors.Seq_kind []) bt)
          (fun function_parameter =>
            let 'tt := function_parameter in
            op_gtgteqquestion
              (check_kind
                (cons Tezos_raw_protocol_alpha.Script_tc_errors.Seq_kind []) bf)
              (fun function_parameter =>
                let 'tt := function_parameter in
                op_gtgteqquestion (fail_unexpected_annot loc annot)
                  (fun function_parameter =>
                    let 'tt := function_parameter in
                    op_gtgteqquestion
                      (parse_instr type_logger tc_context ctxt legacy bt rest)
                      (fun function_parameter =>
                        let '(btr, ctxt) := function_parameter in
                        op_gtgteqquestion
                          (parse_instr type_logger tc_context ctxt legacy bf
                            rest)
                          (fun function_parameter =>
                            let '(bfr, ctxt) := function_parameter in
                            let branch {B : Set}
                              (ibt :
                              Tezos_raw_protocol_alpha.Script_typed_ir.descr
                                op_dollar169 B) (ibf :
                              Tezos_raw_protocol_alpha.Script_typed_ir.descr
                                op_dollar169 B)
                              : Tezos_raw_protocol_alpha.Script_typed_ir.descr
                                (bool * op_dollar169) B :=
                              {|
                                Tezos_raw_protocol_alpha.Script_typed_ir.descr.loc :=
                                  loc;
                                Tezos_raw_protocol_alpha.Script_typed_ir.descr.bef :=
                                  bef;
                                Tezos_raw_protocol_alpha.Script_typed_ir.descr.aft :=
                                  Tezos_raw_protocol_alpha.Script_typed_ir.descr.aft
                                    ibt;
                                Tezos_raw_protocol_alpha.Script_typed_ir.descr.instr :=
                                  Tezos_raw_protocol_alpha.Script_typed_ir.If
                                    ibt ibf |} in
                            op_gtgteqquestion
                              (merge_branches legacy ctxt loc btr bfr
                                {| branch.branch := branch |})
                              (fun function_parameter =>
                                let '(judgement, ctxt) := function_parameter in
                                __return ctxt judgement))))))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_LOOP (cons body [])
          annot,
          (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t _) rest
            _stack_annot) as stack) =>
        op_gtgteqquestion
          (check_kind
            (cons Tezos_raw_protocol_alpha.Script_tc_errors.Seq_kind []) body)
          (fun function_parameter =>
            let 'tt := function_parameter in
            op_gtgteqquestion (fail_unexpected_annot loc annot)
              (fun function_parameter =>
                let 'tt := function_parameter in
                op_gtgteqquestion
                  (parse_instr type_logger tc_context ctxt legacy body rest)
                  (fun function_parameter =>
                    let '(judgement, ctxt) := function_parameter in
                    match judgement with
                    | Typed ibody =>
                      let unmatched_branches (function_parameter : unit)
                        : Tezos_protocol_environment_alpha__Environment.Lwt.t
                          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
                            Tezos_protocol_environment_alpha__Environment.Error_monad.__error) :=
                        let 'tt := function_parameter in
                        op_gtgteqquestion
                          (serialize_stack_for_error ctxt
                            (Tezos_raw_protocol_alpha.Script_typed_ir.descr.aft
                              ibody))
                          (fun function_parameter =>
                            let '(aft, ctxt) := function_parameter in
                            op_gtgtpipequestion
                              (serialize_stack_for_error ctxt stack)
                              (fun function_parameter =>
                                let '(stack, _ctxt) := function_parameter in
                                Tezos_protocol_environment_alpha__Environment.Error_monad.Unmatched_branches
                                  loc aft stack)) in
                      trace_eval unmatched_branches
                        (op_gtgteqquestion
                          (op_atat Lwt.__return
                            (stack_ty_eq ctxt 1
                              (Tezos_raw_protocol_alpha.Script_typed_ir.descr.aft
                                ibody) stack))
                          (fun function_parameter =>
                            let '(Eq, ctxt) := function_parameter in
                            op_gtgteqquestion
                              (op_atat Lwt.__return
                                (merge_stacks legacy loc ctxt
                                  (Tezos_raw_protocol_alpha.Script_typed_ir.descr.aft
                                    ibody) stack))
                              (fun function_parameter =>
                                let '(_stack, ctxt) := function_parameter in
                                typed ctxt loc
                                  (Tezos_raw_protocol_alpha.Script_typed_ir.Loop
                                    ibody) rest)))
                    | Failed {| judgement.Failed.descr := __descr_value |} =>
                      let ibody := __descr_value stack in
                      typed ctxt loc
                        (Tezos_raw_protocol_alpha.Script_typed_ir.Loop ibody)
                        rest
                    end)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_LOOP_LEFT
          (cons body []) annot,
          (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Union_t (tl, l_field)
              (tr, _) _ _) rest union_annot) as stack) =>
        op_gtgteqquestion
          (check_kind
            (cons Tezos_raw_protocol_alpha.Script_tc_errors.Seq_kind []) body)
          (fun function_parameter =>
            let 'tt := function_parameter in
            op_gtgteqquestion (parse_var_annot loc None annot)
              (fun annot =>
                let l_annot :=
                  gen_access_annot union_annot (Some default_left_annot) l_field
                  in
                op_gtgteqquestion
                  (parse_instr type_logger tc_context ctxt legacy body
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t tl rest
                      l_annot))
                  (fun function_parameter =>
                    let '(judgement, ctxt) := function_parameter in
                    match judgement with
                    | Typed ibody =>
                      let unmatched_branches (function_parameter : unit)
                        : Tezos_protocol_environment_alpha__Environment.Lwt.t
                          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
                            Tezos_protocol_environment_alpha__Environment.Error_monad.__error) :=
                        let 'tt := function_parameter in
                        op_gtgteqquestion
                          (serialize_stack_for_error ctxt
                            (Tezos_raw_protocol_alpha.Script_typed_ir.descr.aft
                              ibody))
                          (fun function_parameter =>
                            let '(aft, ctxt) := function_parameter in
                            op_gtgtpipequestion
                              (serialize_stack_for_error ctxt stack)
                              (fun function_parameter =>
                                let '(stack, _ctxt) := function_parameter in
                                Tezos_protocol_environment_alpha__Environment.Error_monad.Unmatched_branches
                                  loc aft stack)) in
                      trace_eval unmatched_branches
                        (op_gtgteqquestion
                          (op_atat Lwt.__return
                            (stack_ty_eq ctxt 1
                              (Tezos_raw_protocol_alpha.Script_typed_ir.descr.aft
                                ibody) stack))
                          (fun function_parameter =>
                            let '(Eq, ctxt) := function_parameter in
                            op_gtgteqquestion
                              (op_atat Lwt.__return
                                (merge_stacks legacy loc ctxt
                                  (Tezos_raw_protocol_alpha.Script_typed_ir.descr.aft
                                    ibody) stack))
                              (fun function_parameter =>
                                let '(_stack, ctxt) := function_parameter in
                                typed ctxt loc
                                  (Tezos_raw_protocol_alpha.Script_typed_ir.Loop_left
                                    ibody)
                                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                                    tr rest annot))))
                    | Failed {| judgement.Failed.descr := __descr_value |} =>
                      let ibody := __descr_value stack in
                      typed ctxt loc
                        (Tezos_raw_protocol_alpha.Script_typed_ir.Loop_left
                          ibody)
                        (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t tr rest
                          annot)
                    end)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_LAMBDA
          (cons arg (cons ret (cons code []))) annot, stack) =>
        op_gtgteqquestion (op_atat Lwt.__return (parse_any_ty ctxt legacy arg))
          (fun function_parameter =>
            let '(Ex_ty arg, ctxt) := function_parameter in
            op_gtgteqquestion
              (op_atat Lwt.__return (parse_any_ty ctxt legacy ret))
              (fun function_parameter =>
                let '(Ex_ty ret, ctxt) := function_parameter in
                op_gtgteqquestion
                  (check_kind
                    (cons Tezos_raw_protocol_alpha.Script_tc_errors.Seq_kind [])
                    code)
                  (fun function_parameter =>
                    let 'tt := function_parameter in
                    op_gtgteqquestion (parse_var_annot loc None annot)
                      (fun annot =>
                        op_gtgteqquestion
                          (parse_returning type_logger Lambda ctxt legacy
                            (arg, default_arg_annot) ret code)
                          (fun function_parameter =>
                            let '(lambda, ctxt) := function_parameter in
                            typed ctxt loc
                              (Tezos_raw_protocol_alpha.Script_typed_ir.Lambda
                                lambda)
                              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                                (Tezos_raw_protocol_alpha.Script_typed_ir.Lambda_t
                                  arg ret None) stack annot))))))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_EXEC [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t arg
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Lambda_t param ret _)
              rest _) _) =>
        op_gtgteqquestion
          (check_item_ty ctxt arg param loc
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_EXEC 1 2)
          (fun function_parameter =>
            let '(Eq, _, ctxt) := function_parameter in
            op_gtgteqquestion (parse_var_annot loc None annot)
              (fun annot =>
                typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Exec
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t ret rest
                    annot)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_APPLY [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t capture
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Lambda_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t
                  (capture_ty, _, _) (arg_ty, _, _) lam_annot _) ret _) rest _)
            _) =>
        op_gtgteqquestion
          (op_atat Lwt.__return (check_packable false loc capture_ty))
          (fun function_parameter =>
            let 'tt := function_parameter in
            op_gtgteqquestion
              (check_item_ty ctxt capture capture_ty loc
                Tezos_raw_protocol_alpha.Alpha_context.Script.I_APPLY 1 2)
              (fun function_parameter =>
                let '(Eq, capture_ty, ctxt) := function_parameter in
                op_gtgteqquestion (parse_var_annot loc None annot)
                  (fun annot =>
                    typed ctxt loc
                      (Tezos_raw_protocol_alpha.Script_typed_ir.Apply capture_ty)
                      (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                        (Tezos_raw_protocol_alpha.Script_typed_ir.Lambda_t
                          arg_ty ret lam_annot) rest annot))))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_DIP (cons code [])
          annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t v rest stack_annot) =>
        op_gtgteqquestion (fail_unexpected_annot loc annot)
          (fun function_parameter =>
            let 'tt := function_parameter in
            op_gtgteqquestion
              (check_kind
                (cons Tezos_raw_protocol_alpha.Script_tc_errors.Seq_kind [])
                code)
              (fun function_parameter =>
                let 'tt := function_parameter in
                op_gtgteqquestion
                  (parse_instr type_logger (add_dip v stack_annot tc_context)
                    ctxt legacy code rest)
                  (fun function_parameter =>
                    let '(judgement, ctxt) := function_parameter in
                    match judgement with
                    | Typed __descr_value =>
                      typed ctxt loc
                        (Tezos_raw_protocol_alpha.Script_typed_ir.Dip
                          __descr_value)
                        (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t v
                          (Tezos_raw_protocol_alpha.Script_typed_ir.descr.aft
                            __descr_value) stack_annot)
                    | Failed _ =>
                      fail
                        (Tezos_protocol_environment_alpha__Environment.Error_monad.Fail_not_in_tail_position
                          loc)
                    end)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_DIP
          (cons n (cons code [])) result_annot, stack) =>
        let fix make_proof_argument {tstk : Set}
          (n : Z) (inner_tc_context : tc_context) (stk :
          Tezos_raw_protocol_alpha.Script_typed_ir.stack_ty tstk)
          : Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
              (dipn_proof_argument tstk)) :=
          match ((op_eq n 0), stk) with
          | (true, rest) =>
            op_gtgteqquestion
              (parse_instr type_logger inner_tc_context ctxt legacy code rest)
              (fun function_parameter =>
                let '(judgement, ctxt) := function_parameter in
                match judgement with
                | Typed __descr_value =>
                  op_atat outer_return
                    (Dipn_proof_argument
                      (Tezos_raw_protocol_alpha.Script_typed_ir.Rest,
                        (ctxt, __descr_value),
                        (Tezos_raw_protocol_alpha.Script_typed_ir.descr.aft
                          __descr_value)))
                | Failed _ =>
                  fail
                    (Tezos_protocol_environment_alpha__Environment.Error_monad.Fail_not_in_tail_position
                      loc)
                end)
          |
            (false, Tezos_raw_protocol_alpha.Script_typed_ir.Item_t v rest annot)
            =>
            op_gtgteqquestion
              (make_proof_argument (op_minus n 1) (add_dip v annot tc_context)
                rest)
              (fun function_parameter =>
                let 'Dipn_proof_argument (n', __descr_value, aft') :=
                  function_parameter in
                op_atat outer_return
                  (Dipn_proof_argument
                    ((Tezos_raw_protocol_alpha.Script_typed_ir.Prefix n'),
                      __descr_value,
                      (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t v aft'
                        annot))))
          | (_, _) =>
            op_gtgteqquestion (serialize_stack_for_error ctxt stack)
              (fun function_parameter =>
                let '(whole_stack, _ctxt) := function_parameter in
                fail
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.Bad_stack
                    loc Tezos_raw_protocol_alpha.Alpha_context.Script.I_DIP 1
                    whole_stack))
          end in
        op_gtgteqquestion (Lwt.__return (parse_int32 n))
          (fun n =>
            op_gtgteqquestion (fail_unexpected_annot loc result_annot)
              (fun function_parameter =>
                let 'tt := function_parameter in
                op_gtgteqquestion (make_proof_argument n tc_context stack)
                  (fun function_parameter =>
                    let
                      'Dipn_proof_argument (n', (new_ctxt, __descr_value), aft) :=
                      function_parameter in
                    typed new_ctxt loc
                      (Tezos_raw_protocol_alpha.Script_typed_ir.Dipn n n'
                        __descr_value) aft)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_DIP
          (([] | cons _ (cons _ (cons _ _))) as l) _, _) =>
        fail
          (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_arity
            loc Tezos_raw_protocol_alpha.Alpha_context.Script.I_DIP 2
            (List.length l))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_FAILWITH [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t v _rest _) =>
        op_gtgteqquestion (fail_unexpected_annot loc annot)
          (fun function_parameter =>
            let 'tt := function_parameter in
            let __descr_value {B : Set}
              (aft : Tezos_raw_protocol_alpha.Script_typed_ir.stack_ty B)
              : Tezos_raw_protocol_alpha.Script_typed_ir.descr bef B :=
              {| Tezos_raw_protocol_alpha.Script_typed_ir.descr.loc := loc;
                Tezos_raw_protocol_alpha.Script_typed_ir.descr.bef := stack_ty;
                Tezos_raw_protocol_alpha.Script_typed_ir.descr.aft := aft;
                Tezos_raw_protocol_alpha.Script_typed_ir.descr.instr :=
                  Tezos_raw_protocol_alpha.Script_typed_ir.Failwith v |} in
            op_gtgteqquestion
              (log_stack ctxt loc stack_ty
                Tezos_raw_protocol_alpha.Script_typed_ir.Empty_t)
              (fun function_parameter =>
                let 'tt := function_parameter in
                __return ctxt
                  (Failed {| judgement.Failed.descr := __descr_value |})))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_ADD [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_t tname)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t _) rest _) _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            typed ctxt loc
              Tezos_raw_protocol_alpha.Script_typed_ir.Add_timestamp_to_seconds
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_t tname)
                rest annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_ADD [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t _)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_t tname) rest
              _) _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            typed ctxt loc
              Tezos_raw_protocol_alpha.Script_typed_ir.Add_seconds_to_timestamp
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_t tname)
                rest annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_SUB [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_t tname)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t _) rest _) _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            typed ctxt loc
              Tezos_raw_protocol_alpha.Script_typed_ir.Sub_timestamp_seconds
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_t tname)
                rest annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_SUB [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_t tn1)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_t tn2) rest _)
            _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            op_gtgteqquestion
              (op_atat Lwt.__return (merge_type_annot legacy tn1 tn2))
              (fun tname =>
                typed ctxt loc
                  Tezos_raw_protocol_alpha.Script_typed_ir.Diff_timestamps
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t tname) rest
                    annot)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_CONCAT [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.String_t tn1)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.String_t tn2) rest _) _)
        =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            op_gtgteqquestion
              (op_atat Lwt.__return (merge_type_annot legacy tn1 tn2))
              (fun tname =>
                typed ctxt loc
                  Tezos_raw_protocol_alpha.Script_typed_ir.Concat_string_pair
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                    (Tezos_raw_protocol_alpha.Script_typed_ir.String_t tname)
                    rest annot)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_CONCAT [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.List_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.String_t tname) _ _)
            rest list_annot) =>
        op_gtgteqquestion (parse_var_annot loc (Some list_annot) annot)
          (fun annot =>
            typed ctxt loc
              Tezos_raw_protocol_alpha.Script_typed_ir.Concat_string
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.String_t tname) rest
                annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_SLICE [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t _)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t _)
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.String_t tname) rest
                string_annot) _) _) =>
        op_gtgteqquestion
          (parse_var_annot loc
            (Some (gen_access_annot string_annot None default_slice_annot))
            annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Slice_string
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Option_t
                  (Tezos_raw_protocol_alpha.Script_typed_ir.String_t tname) None
                  false) rest annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_SIZE [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.String_t _) rest _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.String_size
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t None) rest annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_CONCAT [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_t tn1)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_t tn2) rest _) _)
        =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            op_gtgteqquestion
              (op_atat Lwt.__return (merge_type_annot legacy tn1 tn2))
              (fun tname =>
                typed ctxt loc
                  Tezos_raw_protocol_alpha.Script_typed_ir.Concat_bytes_pair
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_t tname)
                    rest annot)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_CONCAT [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.List_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_t tname) _ _) rest
            list_annot) =>
        op_gtgteqquestion (parse_var_annot loc (Some list_annot) annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Concat_bytes
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_t tname) rest
                annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_SLICE [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t _)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t _)
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_t tname) rest
                bytes_annot) _) _) =>
        op_gtgteqquestion
          (parse_var_annot loc
            (Some (gen_access_annot bytes_annot None default_slice_annot)) annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Slice_bytes
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Option_t
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_t tname) None
                  false) rest annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_SIZE [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_t _) rest _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_size
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t None) rest annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_ADD [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_t tn1)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_t tn2) rest _) _)
        =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            op_gtgteqquestion
              (op_atat Lwt.__return (merge_type_annot legacy tn1 tn2))
              (fun tname =>
                typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Add_tez
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_t tname)
                    rest annot)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_SUB [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_t tn1)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_t tn2) rest _) _)
        =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            op_gtgteqquestion
              (op_atat Lwt.__return (merge_type_annot legacy tn1 tn2))
              (fun tname =>
                typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Sub_tez
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_t tname)
                    rest annot)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_MUL [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_t tname)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t _) rest _) _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Mul_teznat
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_t tname) rest
                annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_MUL [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t _)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_t tname) rest _) _)
        =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Mul_nattez
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_t tname) rest
                annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_OR [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t tn1)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t tn2) rest _) _)
        =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            op_gtgteqquestion
              (op_atat Lwt.__return (merge_type_annot legacy tn1 tn2))
              (fun tname =>
                typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Or
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t tname) rest
                    annot)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_AND [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t tn1)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t tn2) rest _) _)
        =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            op_gtgteqquestion
              (op_atat Lwt.__return (merge_type_annot legacy tn1 tn2))
              (fun tname =>
                typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.And
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t tname) rest
                    annot)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_XOR [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t tn1)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t tn2) rest _) _)
        =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            op_gtgteqquestion
              (op_atat Lwt.__return (merge_type_annot legacy tn1 tn2))
              (fun tname =>
                typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Xor
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t tname) rest
                    annot)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_NOT [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t tname) rest _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Not
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t tname) rest
                annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_ABS [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t _) rest _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Abs_int
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t None) rest annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_ISNAT [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t _) rest int_annot)
        =>
        op_gtgteqquestion (parse_var_annot loc (Some int_annot) annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Is_nat
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Option_t
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t None) None
                  false) rest annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_INT [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t _) rest _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Int_nat
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t None) rest annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_NEG [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t tname) rest _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Neg_int
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t tname) rest
                annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_NEG [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t _) rest _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Neg_nat
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t None) rest annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_ADD [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t tn1)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t tn2) rest _) _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            op_gtgteqquestion
              (op_atat Lwt.__return (merge_type_annot legacy tn1 tn2))
              (fun tname =>
                typed ctxt loc
                  Tezos_raw_protocol_alpha.Script_typed_ir.Add_intint
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t tname) rest
                    annot)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_ADD [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t tname)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t _) rest _) _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Add_intnat
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t tname) rest
                annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_ADD [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t _)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t tname) rest _) _)
        =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Add_natint
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t tname) rest
                annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_ADD [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t tn1)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t tn2) rest _) _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            op_gtgteqquestion
              (op_atat Lwt.__return (merge_type_annot legacy tn1 tn2))
              (fun tname =>
                typed ctxt loc
                  Tezos_raw_protocol_alpha.Script_typed_ir.Add_natnat
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t tname) rest
                    annot)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_SUB [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t tn1)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t tn2) rest _) _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            op_gtgteqquestion
              (op_atat Lwt.__return (merge_type_annot legacy tn1 tn2))
              (fun tname =>
                typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Sub_int
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t tname) rest
                    annot)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_SUB [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t tname)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t _) rest _) _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Sub_int
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t tname) rest
                annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_SUB [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t _)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t tname) rest _) _)
        =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Sub_int
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t tname) rest
                annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_SUB [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t tn1)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t tn2) rest _) _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            op_gtgteqquestion
              (op_atat Lwt.__return (merge_type_annot legacy tn1 tn2))
              (fun _tname =>
                typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Sub_int
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t None) rest
                    annot)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_MUL [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t tn1)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t tn2) rest _) _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            op_gtgteqquestion
              (op_atat Lwt.__return (merge_type_annot legacy tn1 tn2))
              (fun tname =>
                typed ctxt loc
                  Tezos_raw_protocol_alpha.Script_typed_ir.Mul_intint
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t tname) rest
                    annot)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_MUL [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t tname)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t _) rest _) _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Mul_intnat
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t tname) rest
                annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_MUL [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t _)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t tname) rest _) _)
        =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Mul_natint
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t tname) rest
                annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_MUL [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t tn1)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t tn2) rest _) _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            op_gtgteqquestion
              (op_atat Lwt.__return (merge_type_annot legacy tn1 tn2))
              (fun tname =>
                typed ctxt loc
                  Tezos_raw_protocol_alpha.Script_typed_ir.Mul_natnat
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t tname) rest
                    annot)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_EDIV [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_t tname)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t _) rest _) _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Ediv_teznat
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Option_t
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t
                    ((Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_t tname),
                      None, None)
                    ((Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_t tname),
                      None, None) None false) None false) rest annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_EDIV [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_t tn1)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_t tn2) rest _) _)
        =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            op_gtgteqquestion
              (op_atat Lwt.__return (merge_type_annot legacy tn1 tn2))
              (fun tname =>
                typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Ediv_tez
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Option_t
                      (Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t
                        ((Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t None),
                          None, None)
                        ((Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_t tname),
                          None, None) None false) None false) rest annot)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_EDIV [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t tn1)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t tn2) rest _) _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            op_gtgteqquestion
              (op_atat Lwt.__return (merge_type_annot legacy tn1 tn2))
              (fun tname =>
                typed ctxt loc
                  Tezos_raw_protocol_alpha.Script_typed_ir.Ediv_intint
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Option_t
                      (Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t
                        ((Tezos_raw_protocol_alpha.Script_typed_ir.Int_t tname),
                          None, None)
                        ((Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t None),
                          None, None) None false) None false) rest annot)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_EDIV [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t tname)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t _) rest _) _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Ediv_intnat
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Option_t
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t
                    ((Tezos_raw_protocol_alpha.Script_typed_ir.Int_t tname),
                      None, None)
                    ((Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t None),
                      None, None) None false) None false) rest annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_EDIV [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t tname)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t _) rest _) _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Ediv_natint
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Option_t
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t
                    ((Tezos_raw_protocol_alpha.Script_typed_ir.Int_t None),
                      None, None)
                    ((Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t tname),
                      None, None) None false) None false) rest annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_EDIV [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t tn1)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t tn2) rest _) _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            op_gtgteqquestion
              (op_atat Lwt.__return (merge_type_annot legacy tn1 tn2))
              (fun tname =>
                typed ctxt loc
                  Tezos_raw_protocol_alpha.Script_typed_ir.Ediv_natnat
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Option_t
                      (Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t
                        ((Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t tname),
                          None, None)
                        ((Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t tname),
                          None, None) None false) None false) rest annot)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_LSL [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t tn1)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t tn2) rest _) _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            op_gtgteqquestion
              (op_atat Lwt.__return (merge_type_annot legacy tn1 tn2))
              (fun tname =>
                typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Lsl_nat
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t tname) rest
                    annot)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_LSR [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t tn1)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t tn2) rest _) _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            op_gtgteqquestion
              (op_atat Lwt.__return (merge_type_annot legacy tn1 tn2))
              (fun tname =>
                typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Lsr_nat
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t tname) rest
                    annot)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_OR [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t tn1)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t tn2) rest _) _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            op_gtgteqquestion
              (op_atat Lwt.__return (merge_type_annot legacy tn1 tn2))
              (fun tname =>
                typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Or_nat
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t tname) rest
                    annot)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_AND [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t tn1)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t tn2) rest _) _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            op_gtgteqquestion
              (op_atat Lwt.__return (merge_type_annot legacy tn1 tn2))
              (fun tname =>
                typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.And_nat
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t tname) rest
                    annot)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_AND [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t _)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t tname) rest _) _)
        =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.And_int_nat
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t tname) rest
                annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_XOR [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t tn1)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t tn2) rest _) _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            op_gtgteqquestion
              (op_atat Lwt.__return (merge_type_annot legacy tn1 tn2))
              (fun tname =>
                typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Xor_nat
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t tname) rest
                    annot)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_NOT [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t tname) rest _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Not_int
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t tname) rest
                annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_NOT [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t _) rest _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Not_nat
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t None) rest annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_COMPARE [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t t1
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t t2 rest _) _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            op_gtgteqquestion
              (check_item_ty ctxt t1 t2 loc
                Tezos_raw_protocol_alpha.Alpha_context.Script.I_COMPARE 1 2)
              (fun function_parameter =>
                let '(Eq, t, ctxt) := function_parameter in
                match comparable_ty_of_ty t with
                | None =>
                  op_gtgteqquestion
                    (Lwt.__return (serialize_ty_for_error ctxt t))
                    (fun function_parameter =>
                      let '(t, _ctxt) := function_parameter in
                      fail
                        (Tezos_protocol_environment_alpha__Environment.Error_monad.Comparable_type_expected
                          loc t))
                | Some key =>
                  typed ctxt loc
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Compare key)
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                      (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t None) rest
                      annot)
                end))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_EQ [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t _) rest _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Eq
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t None) rest
                annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_NEQ [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t _) rest _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Neq
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t None) rest
                annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_LT [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t _) rest _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Lt
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t None) rest
                annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_GT [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t _) rest _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Gt
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t None) rest
                annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_LE [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t _) rest _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Le
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t None) rest
                annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_GE [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t _) rest _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Ge
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t None) rest
                annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_CAST (cons cast_t [])
          annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t t stack item_annot) =>
        op_gtgteqquestion (parse_var_annot loc (Some item_annot) annot)
          (fun annot =>
            op_gtgteqquestion
              (op_atat Lwt.__return (parse_any_ty ctxt legacy cast_t))
              (fun function_parameter =>
                let '(Ex_ty cast_t, ctxt) := function_parameter in
                op_gtgteqquestion (op_atat Lwt.__return (ty_eq ctxt cast_t t))
                  (fun function_parameter =>
                    let '(Eq, ctxt) := function_parameter in
                    op_gtgteqquestion
                      (op_atat Lwt.__return
                        (merge_types legacy ctxt loc cast_t t))
                      (fun function_parameter =>
                        let '(_, ctxt) := function_parameter in
                        typed ctxt loc
                          Tezos_raw_protocol_alpha.Script_typed_ir.Nop
                          (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                            cast_t stack annot)))))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_RENAME [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t t stack _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Nop
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t t stack annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_PACK [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t t rest unpacked_annot)
        =>
        op_gtgteqquestion (Lwt.__return (check_packable true loc t))
          (fun function_parameter =>
            let 'tt := function_parameter in
            op_gtgteqquestion
              (parse_var_annot loc
                (Some (gen_access_annot unpacked_annot None default_pack_annot))
                annot)
              (fun annot =>
                typed ctxt loc (Tezos_raw_protocol_alpha.Script_typed_ir.Pack t)
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_t None) rest
                    annot)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_UNPACK (cons ty [])
          annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_t _) rest
            packed_annot) =>
        op_gtgteqquestion
          (op_atat Lwt.__return (parse_packable_ty ctxt legacy ty))
          (fun function_parameter =>
            let '(Ex_ty t, ctxt) := function_parameter in
            op_gtgteqquestion (parse_var_type_annot loc annot)
              (fun function_parameter =>
                let '(annot, ty_name) := function_parameter in
                let annot :=
                  default_annot
                    (gen_access_annot packed_annot None default_unpack_annot)
                    annot in
                typed ctxt loc
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Unpack t)
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Option_t t ty_name
                      false) rest annot)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_ADDRESS [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Contract_t _ _) rest
            contract_annot) =>
        op_gtgteqquestion
          (parse_var_annot loc
            (Some (gen_access_annot contract_annot None default_addr_annot))
            annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Address
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Address_t None) rest
                annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_CONTRACT (cons ty [])
          annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Address_t _) rest
            addr_annot) =>
        op_gtgteqquestion
          (op_atat Lwt.__return (parse_parameter_ty ctxt legacy ty))
          (fun function_parameter =>
            let '(Ex_ty t, ctxt) := function_parameter in
            op_gtgteqquestion
              (parse_entrypoint_annot loc
                (Some (gen_access_annot addr_annot None default_contract_annot))
                annot)
              (fun function_parameter =>
                let '(annot, entrypoint) := function_parameter in
                op_gtgteqquestion
                  (op_atat Lwt.__return
                    match entrypoint with
                    | None =>
                      Tezos_protocol_environment_alpha__Environment.Pervasives.Ok
                        "default" % string
                    | Some (Field_annot "default" % string) =>
                      __error_value
                        (Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_annotation
                          loc)
                    | Some (Field_annot entrypoint) =>
                      if op_gt (String.length entrypoint) 31 then
                        __error_value
                          (Tezos_protocol_environment_alpha__Environment.Error_monad.Entrypoint_name_too_long
                            entrypoint)
                      else
                        Tezos_protocol_environment_alpha__Environment.Pervasives.Ok
                          entrypoint
                    end)
                  (fun entrypoint =>
                    typed ctxt loc
                      (Tezos_raw_protocol_alpha.Script_typed_ir.Contract t
                        entrypoint)
                      (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                        (Tezos_raw_protocol_alpha.Script_typed_ir.Option_t
                          (Tezos_raw_protocol_alpha.Script_typed_ir.Contract_t t
                            None) None false) rest annot))))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_TRANSFER_TOKENS []
          annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t p
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_t _)
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Contract_t cp _) rest
                _) _) _) =>
        op_gtgteqquestion
          (check_item_ty ctxt p cp loc
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_TRANSFER_TOKENS 1 4)
          (fun function_parameter =>
            let '(Eq, _, ctxt) := function_parameter in
            op_gtgteqquestion (parse_var_annot loc None annot)
              (fun annot =>
                typed ctxt loc
                  Tezos_raw_protocol_alpha.Script_typed_ir.Transfer_tokens
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Operation_t None)
                    rest annot)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_SET_DELEGATE [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Option_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_t _) _ _) rest
            _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Set_delegate
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Operation_t None) rest
                annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_CREATE_ACCOUNT []
          annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_t _)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Option_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_t _) _ _)
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t _)
                (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_t _) rest _) _)
              _) _) =>
        if legacy then
          op_gtgteqquestion (parse_two_var_annot loc annot)
            (fun function_parameter =>
              let '(op_annot, addr_annot) := function_parameter in
              typed ctxt loc
                Tezos_raw_protocol_alpha.Script_typed_ir.Create_account
                (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Operation_t None)
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Address_t None)
                    rest addr_annot) op_annot))
        else
          fail
            (Tezos_protocol_environment_alpha__Environment.Error_monad.Deprecated_instruction
              Tezos_raw_protocol_alpha.Alpha_context.Script.I_CREATE_ACCOUNT)
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_IMPLICIT_ACCOUNT []
          annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_t _) rest _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            typed ctxt loc
              Tezos_raw_protocol_alpha.Script_typed_ir.Implicit_account
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Contract_t
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Unit_t None) None)
                rest annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_CREATE_CONTRACT
          (cons
            ((Tezos_protocol_environment_alpha__Environment.Micheline.Seq _ _)
              as code) []) annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_t _)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Option_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_t _) _ _)
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t _)
                (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t _)
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_t _)
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t ginit rest
                      _) _) _) _) _) _) =>
        if legacy then
          op_gtgteqquestion (parse_two_var_annot loc annot)
            (fun function_parameter =>
              let '(op_annot, addr_annot) := function_parameter in
              let cannonical_code :=
                op_atat fst (Micheline.extract_locations code) in
              op_gtgteqquestion
                (op_atat Lwt.__return (parse_toplevel legacy cannonical_code))
                (fun function_parameter =>
                  let '(arg_type, storage_type, code_field, root_name) :=
                    function_parameter in
                  op_gtgteqquestion
                    (trace
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.Ill_formed_type
                        (Some "parameter" % string) cannonical_code
                        (location arg_type))
                      (op_atat Lwt.__return
                        (parse_parameter_ty ctxt legacy arg_type)))
                    (fun function_parameter =>
                      let '(Ex_ty arg_type, ctxt) := function_parameter in
                      op_gtgteqquestion
                        (if legacy then
                          Error_monad.__return tt
                        else
                          Lwt.__return
                            (well_formed_entrypoints arg_type root_name))
                        (fun function_parameter =>
                          let 'tt := function_parameter in
                          op_gtgteqquestion
                            (trace
                              (Tezos_protocol_environment_alpha__Environment.Error_monad.Ill_formed_type
                                (Some "storage" % string) cannonical_code
                                (location storage_type))
                              (op_atat Lwt.__return
                                (parse_storage_ty ctxt legacy storage_type)))
                            (fun function_parameter =>
                              let '(Ex_ty storage_type, ctxt) :=
                                function_parameter in
                              let arg_annot :=
                                default_annot default_param_annot
                                  (type_to_var_annot (name_of_ty arg_type)) in
                              let storage_annot :=
                                default_annot default_storage_annot
                                  (type_to_var_annot (name_of_ty storage_type))
                                in
                              let arg_type_full :=
                                Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t
                                  (arg_type, None, arg_annot)
                                  (storage_type, None, storage_annot) None
                                  (op_pipepipe (has_big_map arg_type)
                                    (has_big_map storage_type)) in
                              let ret_type_full :=
                                Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t
                                  ((Tezos_raw_protocol_alpha.Script_typed_ir.List_t
                                    (Tezos_raw_protocol_alpha.Script_typed_ir.Operation_t
                                      None) None false), None, None)
                                  (storage_type, None, None) None
                                  (has_big_map storage_type) in
                              op_gtgteqquestion
                                (trace
                                  (Tezos_protocol_environment_alpha__Environment.Error_monad.Ill_typed_contract
                                    cannonical_code [])
                                  (parse_returning type_logger
                                    (Toplevel
                                      {|
                                        tc_context.Toplevel.storage_type :=
                                          storage_type;
                                        tc_context.Toplevel.param_type :=
                                          arg_type;
                                        tc_context.Toplevel.root_name :=
                                          root_name;
                                        tc_context.Toplevel.legacy_create_contract_literal :=
                                          true |}) ctxt legacy
                                    (arg_type_full, None) ret_type_full
                                    code_field))
                                (fun function_parameter =>
                                  let
                                    '((Tezos_raw_protocol_alpha.Script_typed_ir.Lam
                                      {|
                                      Tezos_raw_protocol_alpha.Script_typed_ir.descr.bef :=
                                        Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                                          arg
                                          Tezos_raw_protocol_alpha.Script_typed_ir.Empty_t
                                          _;
                                        Tezos_raw_protocol_alpha.Script_typed_ir.descr.aft
                                          :=
                                          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                                            ret
                                            Tezos_raw_protocol_alpha.Script_typed_ir.Empty_t
                                            _
                                        |} _) as lambda, ctxt) :=
                                    function_parameter in
                                  op_gtgteqquestion
                                    (op_atat Lwt.__return
                                      (ty_eq ctxt arg arg_type_full))
                                    (fun function_parameter =>
                                      let '(Eq, ctxt) := function_parameter in
                                      op_gtgteqquestion
                                        (op_atat Lwt.__return
                                          (merge_types legacy ctxt loc arg
                                            arg_type_full))
                                        (fun function_parameter =>
                                          let '(_, ctxt) := function_parameter
                                            in
                                          op_gtgteqquestion
                                            (op_atat Lwt.__return
                                              (ty_eq ctxt ret ret_type_full))
                                            (fun function_parameter =>
                                              let '(Eq, ctxt) :=
                                                function_parameter in
                                              op_gtgteqquestion
                                                (op_atat Lwt.__return
                                                  (merge_types legacy ctxt loc
                                                    ret ret_type_full))
                                                (fun function_parameter =>
                                                  let '(_, ctxt) :=
                                                    function_parameter in
                                                  op_gtgteqquestion
                                                    (op_atat Lwt.__return
                                                      (ty_eq ctxt storage_type
                                                        ginit))
                                                    (fun function_parameter =>
                                                      let '(Eq, ctxt) :=
                                                        function_parameter in
                                                      op_gtgteqquestion
                                                        (op_atat Lwt.__return
                                                          (merge_types legacy
                                                            ctxt loc
                                                            storage_type ginit))
                                                        (fun function_parameter
                                                          =>
                                                          let '(_, ctxt) :=
                                                            function_parameter
                                                            in
                                                          typed ctxt loc
                                                            (Tezos_raw_protocol_alpha.Script_typed_ir.Create_contract
                                                              storage_type
                                                              arg_type lambda
                                                              root_name)
                                                            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                                                              (Tezos_raw_protocol_alpha.Script_typed_ir.Operation_t
                                                                None)
                                                              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                                                                (Tezos_raw_protocol_alpha.Script_typed_ir.Address_t
                                                                  None) rest
                                                                addr_annot)
                                                              op_annot)))))))))))))
        else
          fail
            (Tezos_protocol_environment_alpha__Environment.Error_monad.Deprecated_instruction
              Tezos_raw_protocol_alpha.Alpha_context.Script.I_CREATE_CONTRACT)
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_CREATE_CONTRACT
          (cons
            ((Tezos_protocol_environment_alpha__Environment.Micheline.Seq _ _)
              as code) []) annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Option_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_t _) _ _)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_t _)
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t ginit rest _) _)
            _) =>
        op_gtgteqquestion (parse_two_var_annot loc annot)
          (fun function_parameter =>
            let '(op_annot, addr_annot) := function_parameter in
            let cannonical_code :=
              op_atat fst (Micheline.extract_locations code) in
            op_gtgteqquestion
              (op_atat Lwt.__return (parse_toplevel legacy cannonical_code))
              (fun function_parameter =>
                let '(arg_type, storage_type, code_field, root_name) :=
                  function_parameter in
                op_gtgteqquestion
                  (trace
                    (Tezos_protocol_environment_alpha__Environment.Error_monad.Ill_formed_type
                      (Some "parameter" % string) cannonical_code
                      (location arg_type))
                    (op_atat Lwt.__return
                      (parse_parameter_ty ctxt legacy arg_type)))
                  (fun function_parameter =>
                    let '(Ex_ty arg_type, ctxt) := function_parameter in
                    op_gtgteqquestion
                      (if legacy then
                        Error_monad.__return tt
                      else
                        Lwt.__return
                          (well_formed_entrypoints arg_type root_name))
                      (fun function_parameter =>
                        let 'tt := function_parameter in
                        op_gtgteqquestion
                          (trace
                            (Tezos_protocol_environment_alpha__Environment.Error_monad.Ill_formed_type
                              (Some "storage" % string) cannonical_code
                              (location storage_type))
                            (op_atat Lwt.__return
                              (parse_storage_ty ctxt legacy storage_type)))
                          (fun function_parameter =>
                            let '(Ex_ty storage_type, ctxt) :=
                              function_parameter in
                            let arg_annot :=
                              default_annot default_param_annot
                                (type_to_var_annot (name_of_ty arg_type)) in
                            let storage_annot :=
                              default_annot default_storage_annot
                                (type_to_var_annot (name_of_ty storage_type)) in
                            let arg_type_full :=
                              Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t
                                (arg_type, None, arg_annot)
                                (storage_type, None, storage_annot) None
                                (op_pipepipe (has_big_map arg_type)
                                  (has_big_map storage_type)) in
                            let ret_type_full :=
                              Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t
                                ((Tezos_raw_protocol_alpha.Script_typed_ir.List_t
                                  (Tezos_raw_protocol_alpha.Script_typed_ir.Operation_t
                                    None) None false), None, None)
                                (storage_type, None, None) None
                                (has_big_map storage_type) in
                            op_gtgteqquestion
                              (trace
                                (Tezos_protocol_environment_alpha__Environment.Error_monad.Ill_typed_contract
                                  cannonical_code [])
                                (parse_returning type_logger
                                  (Toplevel
                                    {|
                                      tc_context.Toplevel.storage_type :=
                                        storage_type;
                                      tc_context.Toplevel.param_type := arg_type;
                                      tc_context.Toplevel.root_name := root_name;
                                      tc_context.Toplevel.legacy_create_contract_literal :=
                                        false |}) ctxt legacy
                                  (arg_type_full, None) ret_type_full code_field))
                              (fun function_parameter =>
                                let
                                  '((Tezos_raw_protocol_alpha.Script_typed_ir.Lam
                                    {|
                                    Tezos_raw_protocol_alpha.Script_typed_ir.descr.bef :=
                                      Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                                        arg
                                        Tezos_raw_protocol_alpha.Script_typed_ir.Empty_t
                                        _;
                                      Tezos_raw_protocol_alpha.Script_typed_ir.descr.aft
                                        :=
                                        Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                                          ret
                                          Tezos_raw_protocol_alpha.Script_typed_ir.Empty_t
                                          _
                                      |} _) as lambda, ctxt) :=
                                  function_parameter in
                                op_gtgteqquestion
                                  (op_atat Lwt.__return
                                    (ty_eq ctxt arg arg_type_full))
                                  (fun function_parameter =>
                                    let '(Eq, ctxt) := function_parameter in
                                    op_gtgteqquestion
                                      (op_atat Lwt.__return
                                        (merge_types legacy ctxt loc arg
                                          arg_type_full))
                                      (fun function_parameter =>
                                        let '(_, ctxt) := function_parameter in
                                        op_gtgteqquestion
                                          (op_atat Lwt.__return
                                            (ty_eq ctxt ret ret_type_full))
                                          (fun function_parameter =>
                                            let '(Eq, ctxt) :=
                                              function_parameter in
                                            op_gtgteqquestion
                                              (op_atat Lwt.__return
                                                (merge_types legacy ctxt loc ret
                                                  ret_type_full))
                                              (fun function_parameter =>
                                                let '(_, ctxt) :=
                                                  function_parameter in
                                                op_gtgteqquestion
                                                  (op_atat Lwt.__return
                                                    (ty_eq ctxt storage_type
                                                      ginit))
                                                  (fun function_parameter =>
                                                    let '(Eq, ctxt) :=
                                                      function_parameter in
                                                    op_gtgteqquestion
                                                      (op_atat Lwt.__return
                                                        (merge_types legacy ctxt
                                                          loc storage_type ginit))
                                                      (fun function_parameter =>
                                                        let '(_, ctxt) :=
                                                          function_parameter in
                                                        typed ctxt loc
                                                          (Tezos_raw_protocol_alpha.Script_typed_ir.Create_contract_2
                                                            storage_type
                                                            arg_type lambda
                                                            root_name)
                                                          (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                                                            (Tezos_raw_protocol_alpha.Script_typed_ir.Operation_t
                                                              None)
                                                            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                                                              (Tezos_raw_protocol_alpha.Script_typed_ir.Address_t
                                                                None) rest
                                                              addr_annot)
                                                            op_annot)))))))))))))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_NOW [] annot, stack)
        =>
        op_gtgteqquestion (parse_var_annot loc (Some default_now_annot) annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Now
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_t None)
                stack annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_AMOUNT [] annot, stack)
        =>
        op_gtgteqquestion
          (parse_var_annot loc (Some default_amount_annot) annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Amount
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_t None) stack
                annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_CHAIN_ID [] annot,
          stack) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.ChainId
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Chain_id_t None) stack
                annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_BALANCE [] annot,
          stack) =>
        op_gtgteqquestion
          (parse_var_annot loc (Some default_balance_annot) annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Balance
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_t None) stack
                annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_HASH_KEY [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Key_t _) rest _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Hash_key
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_t None) rest
                annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_CHECK_SIGNATURE []
          annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Key_t _)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Signature_t _)
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_t _) rest _) _)
            _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            typed ctxt loc
              Tezos_raw_protocol_alpha.Script_typed_ir.Check_signature
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t None) rest
                annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_BLAKE2B [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_t _) rest _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Blake2b
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_t None) rest
                annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_SHA256 [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_t _) rest _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Sha256
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_t None) rest
                annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_SHA512 [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_t _) rest _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Sha512
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_t None) rest
                annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_STEPS_TO_QUOTA []
          annot, stack) =>
        if legacy then
          op_gtgteqquestion
            (parse_var_annot loc (Some default_steps_annot) annot)
            (fun annot =>
              typed ctxt loc
                Tezos_raw_protocol_alpha.Script_typed_ir.Steps_to_quota
                (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t None) stack
                  annot))
        else
          fail
            (Tezos_protocol_environment_alpha__Environment.Error_monad.Deprecated_instruction
              Tezos_raw_protocol_alpha.Alpha_context.Script.I_STEPS_TO_QUOTA)
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_SOURCE [] annot, stack)
        =>
        op_gtgteqquestion
          (parse_var_annot loc (Some default_source_annot) annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Source
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Address_t None) stack
                annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_SENDER [] annot, stack)
        =>
        op_gtgteqquestion
          (parse_var_annot loc (Some default_sender_annot) annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Sender
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Address_t None) stack
                annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_SELF [] annot, stack)
        =>
        op_gtgteqquestion
          (parse_entrypoint_annot loc (Some default_self_annot) annot)
          (fun function_parameter =>
            let '(annot, entrypoint) := function_parameter in
            let entrypoint :=
              Option.unopt_map
                (fun function_parameter =>
                  let 'Field_annot annot := function_parameter in
                  annot) "default" % string entrypoint in
            let fix get_toplevel_type (function_parameter : tc_context)
              : Tezos_protocol_environment_alpha__Environment.Lwt.t
                (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
                  (judgement bef *
                    Tezos_raw_protocol_alpha.Alpha_context.context)) :=
              match function_parameter with
              | Lambda =>
                fail
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.Self_in_lambda
                    loc)
              | Dip _ prev => get_toplevel_type prev
              |
                Toplevel {|
                  tc_context.Toplevel.param_type := param_type;
                    tc_context.Toplevel.root_name := root_name;
                    tc_context.Toplevel.legacy_create_contract_literal := false
                    |} =>
                op_gtgteqquestion
                  (Lwt.__return
                    (find_entrypoint param_type root_name entrypoint))
                  (fun function_parameter =>
                    let '(_, Ex_ty param_type) := function_parameter in
                    typed ctxt loc
                      (Tezos_raw_protocol_alpha.Script_typed_ir.Self param_type
                        entrypoint)
                      (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                        (Tezos_raw_protocol_alpha.Script_typed_ir.Contract_t
                          param_type None) stack annot))
              |
                Toplevel {|
                  tc_context.Toplevel.param_type := param_type;
                    tc_context.Toplevel.root_name := _;
                    tc_context.Toplevel.legacy_create_contract_literal := true
                    |} =>
                typed ctxt loc
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Self param_type
                    "default" % string)
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Contract_t
                      param_type None) stack annot)
              end in
            get_toplevel_type tc_context)
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          ((Tezos_raw_protocol_alpha.Alpha_context.Script.I_DUP |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_SWAP |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_SOME |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_UNIT |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_PAIR |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_CAR |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_CDR |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_CONS |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_CONCAT |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_SLICE |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_MEM |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_UPDATE |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_MAP |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_GET |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_EXEC |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_FAILWITH |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_SIZE |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_ADD |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_SUB |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_MUL |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_EDIV |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_OR |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_AND |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_XOR |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_NOT |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_ABS |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_NEG |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_LSL |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_LSR |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_COMPARE |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_EQ |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_NEQ |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_LT |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_GT |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_LE |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_GE |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_TRANSFER_TOKENS |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_CREATE_ACCOUNT |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_SET_DELEGATE |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_NOW |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_IMPLICIT_ACCOUNT |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_AMOUNT |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_BALANCE |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_CHECK_SIGNATURE |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_HASH_KEY |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_SOURCE |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_SENDER |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_BLAKE2B |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_SHA256 |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_SHA512 |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_STEPS_TO_QUOTA |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_ADDRESS) as name)
          ((cons _ _) as l) _, _) =>
        fail
          (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_arity
            loc name 0 (List.length l))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          ((Tezos_raw_protocol_alpha.Alpha_context.Script.I_NONE |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_LEFT |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_RIGHT |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_NIL |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_MAP |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_ITER |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_EMPTY_SET |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_DIP |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_LOOP |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_LOOP_LEFT |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_CONTRACT) as name)
          (([] | cons _ (cons _ _)) as l) _, _) =>
        fail
          (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_arity
            loc name 1 (List.length l))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          ((Tezos_raw_protocol_alpha.Alpha_context.Script.I_PUSH |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_IF_NONE |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_IF_LEFT |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_IF_CONS |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_EMPTY_MAP |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_IF) as name)
          (([] | cons _ [] | cons _ (cons _ (cons _ _))) as l) _, _) =>
        fail
          (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_arity
            loc name 2 (List.length l))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_LAMBDA
          (([] | cons _ [] | cons _ (cons _ (cons _ (cons _ _)))) as l) _, _) =>
        fail
          (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_arity
            loc Tezos_raw_protocol_alpha.Alpha_context.Script.I_LAMBDA 3
            (List.length l))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          ((Tezos_raw_protocol_alpha.Alpha_context.Script.I_ADD |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_SUB |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_MUL |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_EDIV |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_AND |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_OR |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_XOR |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_LSL |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_LSR) as name) [] _,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t ta
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t tb _ _) _) =>
        op_gtgteqquestion
          (op_atat Lwt.__return (serialize_ty_for_error ctxt ta))
          (fun function_parameter =>
            let '(ta, ctxt) := function_parameter in
            op_gtgteqquestion
              (op_atat Lwt.__return (serialize_ty_for_error ctxt tb))
              (fun function_parameter =>
                let '(tb, _ctxt) := function_parameter in
                fail
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.Undefined_binop
                    loc name ta tb)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          ((Tezos_raw_protocol_alpha.Alpha_context.Script.I_NEG |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_ABS |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_NOT |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_CONCAT |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_SIZE |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_EQ |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_NEQ |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_LT |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_GT |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_LE |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_GE) as name) [] _,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t t _ _) =>
        op_gtgteqquestion (op_atat Lwt.__return (serialize_ty_for_error ctxt t))
          (fun function_parameter =>
            let '(t, _ctxt) := function_parameter in
            fail
              (Tezos_protocol_environment_alpha__Environment.Error_monad.Undefined_unop
                loc name t))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          ((Tezos_raw_protocol_alpha.Alpha_context.Script.I_UPDATE |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_SLICE) as name) [] _,
          stack) =>
        op_gtgteqquestion (serialize_stack_for_error ctxt stack)
          (fun function_parameter =>
            let '(stack, _ctxt) := function_parameter in
            fail
              (Tezos_protocol_environment_alpha__Environment.Error_monad.Bad_stack
                loc name 3 stack))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_CREATE_CONTRACT _ _,
          stack) =>
        op_gtgteqquestion (serialize_stack_for_error ctxt stack)
          (fun function_parameter =>
            let '(stack, _ctxt) := function_parameter in
            fail
              (Tezos_protocol_environment_alpha__Environment.Error_monad.Bad_stack
                loc
                Tezos_raw_protocol_alpha.Alpha_context.Script.I_CREATE_CONTRACT
                7 stack))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_CREATE_ACCOUNT [] _,
          stack) =>
        op_gtgteqquestion (serialize_stack_for_error ctxt stack)
          (fun function_parameter =>
            let '(stack, _ctxt) := function_parameter in
            fail
              (Tezos_protocol_environment_alpha__Environment.Error_monad.Bad_stack
                loc
                Tezos_raw_protocol_alpha.Alpha_context.Script.I_CREATE_ACCOUNT 4
                stack))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_TRANSFER_TOKENS [] _,
          stack) =>
        op_gtgteqquestion (serialize_stack_for_error ctxt stack)
          (fun function_parameter =>
            let '(stack, _ctxt) := function_parameter in
            fail
              (Tezos_protocol_environment_alpha__Environment.Error_monad.Bad_stack
                loc
                Tezos_raw_protocol_alpha.Alpha_context.Script.I_TRANSFER_TOKENS
                4 stack))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          ((Tezos_raw_protocol_alpha.Alpha_context.Script.I_DROP |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_DUP |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_CAR |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_CDR |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_SOME |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_BLAKE2B |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_SHA256 |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_SHA512 |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_DIP |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_IF_NONE |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_LEFT |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_RIGHT |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_IF_LEFT |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_IF |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_LOOP |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_IF_CONS |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_IMPLICIT_ACCOUNT |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_NEG |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_ABS |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_INT |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_NOT |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_HASH_KEY |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_EQ |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_NEQ |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_LT |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_GT |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_LE |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_GE) as name) _ _,
          stack) =>
        op_gtgteqquestion (serialize_stack_for_error ctxt stack)
          (fun function_parameter =>
            let '(stack, _ctxt) := function_parameter in
            fail
              (Tezos_protocol_environment_alpha__Environment.Error_monad.Bad_stack
                loc name 1 stack))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          ((Tezos_raw_protocol_alpha.Alpha_context.Script.I_SWAP |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_PAIR |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_CONS |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_GET |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_MEM |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_EXEC |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_CHECK_SIGNATURE |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_ADD |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_SUB |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_MUL |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_EDIV |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_AND |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_OR |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_XOR |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_LSL |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_LSR) as name) _ _,
          stack) =>
        op_gtgteqquestion (serialize_stack_for_error ctxt stack)
          (fun function_parameter =>
            let '(stack, _ctxt) := function_parameter in
            fail
              (Tezos_protocol_environment_alpha__Environment.Error_monad.Bad_stack
                loc name 2 stack))
      | (expr, _) =>
        op_atat fail
          (unexpected expr
            (cons Tezos_raw_protocol_alpha.Script_tc_errors.Seq_kind [])
            Tezos_raw_protocol_alpha.Script_tc_errors.Instr_namespace
            (cons Tezos_raw_protocol_alpha.Alpha_context.Script.I_DROP
              (cons Tezos_raw_protocol_alpha.Alpha_context.Script.I_DUP
                (cons Tezos_raw_protocol_alpha.Alpha_context.Script.I_DIG
                  (cons Tezos_raw_protocol_alpha.Alpha_context.Script.I_DUG
                    (cons Tezos_raw_protocol_alpha.Alpha_context.Script.I_SWAP
                      (cons Tezos_raw_protocol_alpha.Alpha_context.Script.I_SOME
                        (cons
                          Tezos_raw_protocol_alpha.Alpha_context.Script.I_UNIT
                          (cons
                            Tezos_raw_protocol_alpha.Alpha_context.Script.I_PAIR
                            (cons
                              Tezos_raw_protocol_alpha.Alpha_context.Script.I_CAR
                              (cons
                                Tezos_raw_protocol_alpha.Alpha_context.Script.I_CDR
                                (cons
                                  Tezos_raw_protocol_alpha.Alpha_context.Script.I_CONS
                                  (cons
                                    Tezos_raw_protocol_alpha.Alpha_context.Script.I_MEM
                                    (cons
                                      Tezos_raw_protocol_alpha.Alpha_context.Script.I_UPDATE
                                      (cons
                                        Tezos_raw_protocol_alpha.Alpha_context.Script.I_MAP
                                        (cons
                                          Tezos_raw_protocol_alpha.Alpha_context.Script.I_ITER
                                          (cons
                                            Tezos_raw_protocol_alpha.Alpha_context.Script.I_GET
                                            (cons
                                              Tezos_raw_protocol_alpha.Alpha_context.Script.I_EXEC
                                              (cons
                                                Tezos_raw_protocol_alpha.Alpha_context.Script.I_FAILWITH
                                                (cons
                                                  Tezos_raw_protocol_alpha.Alpha_context.Script.I_SIZE
                                                  (cons
                                                    Tezos_raw_protocol_alpha.Alpha_context.Script.I_CONCAT
                                                    (cons
                                                      Tezos_raw_protocol_alpha.Alpha_context.Script.I_ADD
                                                      (cons
                                                        Tezos_raw_protocol_alpha.Alpha_context.Script.I_SUB
                                                        (cons
                                                          Tezos_raw_protocol_alpha.Alpha_context.Script.I_MUL
                                                          (cons
                                                            Tezos_raw_protocol_alpha.Alpha_context.Script.I_EDIV
                                                            (cons
                                                              Tezos_raw_protocol_alpha.Alpha_context.Script.I_OR
                                                              (cons
                                                                Tezos_raw_protocol_alpha.Alpha_context.Script.I_AND
                                                                (cons
                                                                  Tezos_raw_protocol_alpha.Alpha_context.Script.I_XOR
                                                                  (cons
                                                                    Tezos_raw_protocol_alpha.Alpha_context.Script.I_NOT
                                                                    (cons
                                                                      Tezos_raw_protocol_alpha.Alpha_context.Script.I_ABS
                                                                      (cons
                                                                        Tezos_raw_protocol_alpha.Alpha_context.Script.I_INT
                                                                        (cons
                                                                          Tezos_raw_protocol_alpha.Alpha_context.Script.I_NEG
                                                                          (cons
                                                                            Tezos_raw_protocol_alpha.Alpha_context.Script.I_LSL
                                                                            (cons
                                                                              Tezos_raw_protocol_alpha.Alpha_context.Script.I_LSR
                                                                              (cons
                                                                                Tezos_raw_protocol_alpha.Alpha_context.Script.I_COMPARE
                                                                                (cons
                                                                                  Tezos_raw_protocol_alpha.Alpha_context.Script.I_EQ
                                                                                  (cons
                                                                                    Tezos_raw_protocol_alpha.Alpha_context.Script.I_NEQ
                                                                                    (cons
                                                                                      Tezos_raw_protocol_alpha.Alpha_context.Script.I_LT
                                                                                      (cons
                                                                                        Tezos_raw_protocol_alpha.Alpha_context.Script.I_GT
                                                                                        (cons
                                                                                          Tezos_raw_protocol_alpha.Alpha_context.Script.I_LE
                                                                                          (cons
                                                                                            Tezos_raw_protocol_alpha.Alpha_context.Script.I_GE
                                                                                            (cons
                                                                                              Tezos_raw_protocol_alpha.Alpha_context.Script.I_TRANSFER_TOKENS
                                                                                              (cons
                                                                                                Tezos_raw_protocol_alpha.Alpha_context.Script.I_CREATE_ACCOUNT
                                                                                                (cons
                                                                                                  Tezos_raw_protocol_alpha.Alpha_context.Script.I_CREATE_CONTRACT
                                                                                                  (cons
                                                                                                    Tezos_raw_protocol_alpha.Alpha_context.Script.I_NOW
                                                                                                    (cons
                                                                                                      Tezos_raw_protocol_alpha.Alpha_context.Script.I_AMOUNT
                                                                                                      (cons
                                                                                                        Tezos_raw_protocol_alpha.Alpha_context.Script.I_BALANCE
                                                                                                        (cons
                                                                                                          Tezos_raw_protocol_alpha.Alpha_context.Script.I_IMPLICIT_ACCOUNT
                                                                                                          (cons
                                                                                                            Tezos_raw_protocol_alpha.Alpha_context.Script.I_CHECK_SIGNATURE
                                                                                                            (cons
                                                                                                              Tezos_raw_protocol_alpha.Alpha_context.Script.I_BLAKE2B
                                                                                                              (cons
                                                                                                                Tezos_raw_protocol_alpha.Alpha_context.Script.I_SHA256
                                                                                                                (cons
                                                                                                                  Tezos_raw_protocol_alpha.Alpha_context.Script.I_SHA512
                                                                                                                  (cons
                                                                                                                    Tezos_raw_protocol_alpha.Alpha_context.Script.I_HASH_KEY
                                                                                                                    (cons
                                                                                                                      Tezos_raw_protocol_alpha.Alpha_context.Script.I_STEPS_TO_QUOTA
                                                                                                                      (cons
                                                                                                                        Tezos_raw_protocol_alpha.Alpha_context.Script.I_PUSH
                                                                                                                        (cons
                                                                                                                          Tezos_raw_protocol_alpha.Alpha_context.Script.I_NONE
                                                                                                                          (cons
                                                                                                                            Tezos_raw_protocol_alpha.Alpha_context.Script.I_LEFT
                                                                                                                            (cons
                                                                                                                              Tezos_raw_protocol_alpha.Alpha_context.Script.I_RIGHT
                                                                                                                              (cons
                                                                                                                                Tezos_raw_protocol_alpha.Alpha_context.Script.I_NIL
                                                                                                                                (cons
                                                                                                                                  Tezos_raw_protocol_alpha.Alpha_context.Script.I_EMPTY_SET
                                                                                                                                  (cons
                                                                                                                                    Tezos_raw_protocol_alpha.Alpha_context.Script.I_DIP
                                                                                                                                    (cons
                                                                                                                                      Tezos_raw_protocol_alpha.Alpha_context.Script.I_LOOP
                                                                                                                                      (cons
                                                                                                                                        Tezos_raw_protocol_alpha.Alpha_context.Script.I_IF_NONE
                                                                                                                                        (cons
                                                                                                                                          Tezos_raw_protocol_alpha.Alpha_context.Script.I_IF_LEFT
                                                                                                                                          (cons
                                                                                                                                            Tezos_raw_protocol_alpha.Alpha_context.Script.I_IF_CONS
                                                                                                                                            (cons
                                                                                                                                              Tezos_raw_protocol_alpha.Alpha_context.Script.I_EMPTY_MAP
                                                                                                                                              (cons
                                                                                                                                                Tezos_raw_protocol_alpha.Alpha_context.Script.I_IF
                                                                                                                                                (cons
                                                                                                                                                  Tezos_raw_protocol_alpha.Alpha_context.Script.I_SOURCE
                                                                                                                                                  (cons
                                                                                                                                                    Tezos_raw_protocol_alpha.Alpha_context.Script.I_SENDER
                                                                                                                                                    (cons
                                                                                                                                                      Tezos_raw_protocol_alpha.Alpha_context.Script.I_SELF
                                                                                                                                                      (cons
                                                                                                                                                        Tezos_raw_protocol_alpha.Alpha_context.Script.I_LAMBDA
                                                                                                                                                        [])))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))
      end)

with parse_contract {arg : Set}
  (legacy : bool) (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
  (loc : Tezos_raw_protocol_alpha.Alpha_context.Script.location)
  (arg : Tezos_raw_protocol_alpha.Script_typed_ir.ty arg)
  (contract : Tezos_raw_protocol_alpha.Alpha_context.Contract.t)
  (entrypoint : string)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Alpha_context.context *
        Tezos_raw_protocol_alpha.Script_typed_ir.typed_contract arg)) :=
  op_gtgteqquestion
    (op_atat Lwt.__return (Gas.consume ctxt Typecheck_costs.contract_exists))
    (fun ctxt =>
      op_gtgteqquestion (Contract.__exists ctxt contract)
        (fun function_parameter =>
          match function_parameter with
          | false =>
            fail
              (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_contract
                loc contract)
          | true =>
            op_gtgteqquestion
              (op_atat Lwt.__return
                (Gas.consume ctxt Typecheck_costs.get_script))
              (fun ctxt =>
                op_gtgteqquestion
                  (op_atat
                    (trace
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_contract
                        loc contract)) (Contract.get_script_code ctxt contract))
                  (fun function_parameter =>
                    let '(ctxt, code) := function_parameter in
                    match code with
                    | None =>
                      Lwt.__return
                        (op_gtgtquestion
                          (ty_eq ctxt arg
                            (Tezos_raw_protocol_alpha.Script_typed_ir.Unit_t
                              None))
                          (fun function_parameter =>
                            let '(Eq, ctxt) := function_parameter in
                            match entrypoint with
                            | "default" % string =>
                              let contract := (arg, (contract, entrypoint)) in
                              ok (ctxt, contract)
                            | entrypoint =>
                              __error_value
                                (Tezos_protocol_environment_alpha__Environment.Error_monad.No_such_entrypoint
                                  entrypoint)
                            end))
                    | Some code =>
                      op_gtgteqquestion (Script.force_decode ctxt code)
                        (fun function_parameter =>
                          let '(code, ctxt) := function_parameter in
                          Lwt.__return
                            (op_gtgtquestion (parse_toplevel true code)
                              (fun function_parameter =>
                                let '(arg_type, _, _, root_name) :=
                                  function_parameter in
                                op_gtgtquestion
                                  (parse_parameter_ty ctxt true arg_type)
                                  (fun function_parameter =>
                                    let '(Ex_ty targ, ctxt) :=
                                      function_parameter in
                                    let __return
                                      (ctxt :
                                      Tezos_raw_protocol_alpha.Alpha_context.context)
                                      (targ :
                                      Tezos_raw_protocol_alpha.Script_typed_ir.ty
                                        arg) (entrypoint : string)
                                      : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
                                        (Tezos_raw_protocol_alpha.Alpha_context.context
                                          *
                                          Tezos_raw_protocol_alpha.Script_typed_ir.typed_contract
                                            arg) :=
                                      op_gtgtquestion
                                        (merge_types legacy ctxt loc targ arg)
                                        (fun function_parameter =>
                                          let '(arg, ctxt) := function_parameter
                                            in
                                          let contract :=
                                            (arg, (contract, entrypoint)) in
                                          ok (ctxt, contract)) in
                                    op_gtgtquestion
                                      (find_entrypoint_for_type targ arg
                                        root_name entrypoint ctxt)
                                      (fun function_parameter =>
                                        let '(ctxt, entrypoint, targ) :=
                                          function_parameter in
                                        op_gtgtquestion
                                          (merge_types legacy ctxt loc targ arg)
                                          (fun function_parameter =>
                                            let '(targ, ctxt) :=
                                              function_parameter in
                                            __return ctxt targ entrypoint))))))
                    end))
          end))

with parse_contract_for_script {arg : Set}
  (legacy : bool) (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
  (loc : Tezos_raw_protocol_alpha.Alpha_context.Script.location)
  (arg : Tezos_raw_protocol_alpha.Script_typed_ir.ty arg)
  (contract : Tezos_raw_protocol_alpha.Alpha_context.Contract.t)
  (entrypoint : string)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Alpha_context.context *
        option (Tezos_raw_protocol_alpha.Script_typed_ir.typed_contract arg))) :=
  op_gtgteqquestion
    (op_atat Lwt.__return (Gas.consume ctxt Typecheck_costs.contract_exists))
    (fun ctxt =>
      op_gtgteqquestion (Contract.__exists ctxt contract)
        (fun function_parameter =>
          match function_parameter with
          | false => __return (ctxt, None)
          | true =>
            op_gtgteqquestion
              (op_atat Lwt.__return
                (Gas.consume ctxt Typecheck_costs.get_script))
              (fun ctxt =>
                op_gtgteqquestion
                  (op_atat
                    (trace
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_contract
                        loc contract)) (Contract.get_script_code ctxt contract))
                  (fun function_parameter =>
                    let '(ctxt, code) := function_parameter in
                    match code with
                    | None =>
                      match entrypoint with
                      | "default" % string =>
                        Lwt.__return
                          match
                            ty_eq ctxt arg
                              (Tezos_raw_protocol_alpha.Script_typed_ir.Unit_t
                                None) with
                          |
                            Tezos_protocol_environment_alpha__Environment.Pervasives.Ok
                              (Eq, ctxt) =>
                            let contract := (arg, (contract, entrypoint)) in
                            ok (ctxt, (Some contract))
                          |
                            Tezos_protocol_environment_alpha__Environment.Pervasives.Error
                              _ =>
                            op_gtgtquestion
                              (Gas.consume ctxt Typecheck_costs.cycle)
                              (fun ctxt => ok (ctxt, None))
                          end
                      | _ => __return (ctxt, None)
                      end
                    | Some code =>
                      op_gtgteqquestion (Script.force_decode ctxt code)
                        (fun function_parameter =>
                          let '(code, ctxt) := function_parameter in
                          Lwt.__return
                            match parse_toplevel true code with
                            |
                              Tezos_protocol_environment_alpha__Environment.Pervasives.Error
                                _ =>
                              __error_value
                                (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_contract
                                  loc contract)
                            |
                              Tezos_protocol_environment_alpha__Environment.Pervasives.Ok
                                (arg_type, _, _, root_name) =>
                              match parse_parameter_ty ctxt true arg_type with
                              |
                                Tezos_protocol_environment_alpha__Environment.Pervasives.Error
                                  _ =>
                                __error_value
                                  (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_contract
                                    loc contract)
                              |
                                Tezos_protocol_environment_alpha__Environment.Pervasives.Ok
                                  (Ex_ty targ, ctxt) =>
                                match
                                  op_gtgtquestion
                                    (find_entrypoint_for_type targ arg root_name
                                      entrypoint ctxt)
                                    (fun function_parameter =>
                                      let '(ctxt, entrypoint, targ) :=
                                        function_parameter in
                                      op_gtgtquestion
                                        (merge_types legacy ctxt loc targ arg)
                                        (fun function_parameter =>
                                          let '(targ, ctxt) :=
                                            function_parameter in
                                          op_gtgtquestion
                                            (merge_types legacy ctxt loc targ
                                              arg)
                                            (fun function_parameter =>
                                              let '(arg, ctxt) :=
                                                function_parameter in
                                              let contract :=
                                                (arg, (contract, entrypoint)) in
                                              ok (ctxt, (Some contract))))) with
                                |
                                  Tezos_protocol_environment_alpha__Environment.Pervasives.Ok
                                    res => ok res
                                |
                                  Tezos_protocol_environment_alpha__Environment.Pervasives.Error
                                    _ =>
                                  op_gtgtquestion (ty_eq ctxt targ targ)
                                    (fun function_parameter =>
                                      let '(Eq, ctxt) := function_parameter in
                                      op_gtgtquestion
                                        (merge_types legacy ctxt loc targ targ)
                                        (fun function_parameter =>
                                          let '(_, ctxt) := function_parameter
                                            in
                                          ok (ctxt, None)))
                                end
                              end
                            end)
                    end))
          end))

with parse_toplevel
  (legacy : bool)
  (toplevel : Tezos_raw_protocol_alpha.Alpha_context.Script.expr)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (Tezos_raw_protocol_alpha.Alpha_context.Script.node *
      Tezos_raw_protocol_alpha.Alpha_context.Script.node *
      Tezos_raw_protocol_alpha.Alpha_context.Script.node * option string) :=
  op_atat
    (record_trace
      (Tezos_protocol_environment_alpha__Environment.Error_monad.Ill_typed_contract
        toplevel []))
    match root toplevel with
    | Tezos_protocol_environment_alpha__Environment.Micheline.Int loc _ =>
      __error_value
        (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_kind
          loc (cons Tezos_raw_protocol_alpha.Script_tc_errors.Seq_kind [])
          Tezos_raw_protocol_alpha.Script_tc_errors.Int_kind)
    | Tezos_protocol_environment_alpha__Environment.Micheline.String loc _ =>
      __error_value
        (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_kind
          loc (cons Tezos_raw_protocol_alpha.Script_tc_errors.Seq_kind [])
          Tezos_raw_protocol_alpha.Script_tc_errors.String_kind)
    | Tezos_protocol_environment_alpha__Environment.Micheline.Bytes loc _ =>
      __error_value
        (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_kind
          loc (cons Tezos_raw_protocol_alpha.Script_tc_errors.Seq_kind [])
          Tezos_raw_protocol_alpha.Script_tc_errors.Bytes_kind)
    | Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc _ _ _ =>
      __error_value
        (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_kind
          loc (cons Tezos_raw_protocol_alpha.Script_tc_errors.Seq_kind [])
          Tezos_raw_protocol_alpha.Script_tc_errors.Prim_kind)
    | Tezos_protocol_environment_alpha__Environment.Micheline.Seq _ fields =>
      let fix find_fields
        (p :
        option
          (Tezos_protocol_environment_alpha__Environment.Micheline.node
            Tezos_raw_protocol_alpha.Alpha_context.Script.location
            Tezos_raw_protocol_alpha.Alpha_context.Script.prim *
            Tezos_raw_protocol_alpha.Alpha_context.Script.location *
            Tezos_protocol_environment_alpha__Environment.Micheline.annot)) (s :
        option
          (Tezos_protocol_environment_alpha__Environment.Micheline.node
            Tezos_raw_protocol_alpha.Alpha_context.Script.location
            Tezos_raw_protocol_alpha.Alpha_context.Script.prim *
            Tezos_raw_protocol_alpha.Alpha_context.Script.location *
            Tezos_protocol_environment_alpha__Environment.Micheline.annot)) (c :
        option
          (Tezos_protocol_environment_alpha__Environment.Micheline.node
            Tezos_raw_protocol_alpha.Alpha_context.Script.location
            Tezos_raw_protocol_alpha.Alpha_context.Script.prim *
            Tezos_raw_protocol_alpha.Alpha_context.Script.location *
            Tezos_protocol_environment_alpha__Environment.Micheline.annot))
        (fields :
        list
          (Tezos_protocol_environment_alpha__Environment.Micheline.node
            Tezos_raw_protocol_alpha.Alpha_context.Script.location
            Tezos_raw_protocol_alpha.Alpha_context.Script.prim))
        : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (option
            (Tezos_protocol_environment_alpha__Environment.Micheline.node
              Tezos_raw_protocol_alpha.Alpha_context.Script.location
              Tezos_raw_protocol_alpha.Alpha_context.Script.prim *
              Tezos_raw_protocol_alpha.Alpha_context.Script.location *
              Tezos_protocol_environment_alpha__Environment.Micheline.annot) *
            option
              (Tezos_protocol_environment_alpha__Environment.Micheline.node
                Tezos_raw_protocol_alpha.Alpha_context.Script.location
                Tezos_raw_protocol_alpha.Alpha_context.Script.prim *
                Tezos_raw_protocol_alpha.Alpha_context.Script.location *
                Tezos_protocol_environment_alpha__Environment.Micheline.annot) *
            option
              (Tezos_protocol_environment_alpha__Environment.Micheline.node
                Tezos_raw_protocol_alpha.Alpha_context.Script.location
                Tezos_raw_protocol_alpha.Alpha_context.Script.prim *
                Tezos_raw_protocol_alpha.Alpha_context.Script.location *
                Tezos_protocol_environment_alpha__Environment.Micheline.annot)) :=
        match fields with
        | [] => ok (p, s, c)
        |
          cons
            (Tezos_protocol_environment_alpha__Environment.Micheline.Int loc _)
            _ =>
          __error_value
            (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_kind
              loc (cons Tezos_raw_protocol_alpha.Script_tc_errors.Prim_kind [])
              Tezos_raw_protocol_alpha.Script_tc_errors.Int_kind)
        |
          cons
            (Tezos_protocol_environment_alpha__Environment.Micheline.String loc
              _) _ =>
          __error_value
            (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_kind
              loc (cons Tezos_raw_protocol_alpha.Script_tc_errors.Prim_kind [])
              Tezos_raw_protocol_alpha.Script_tc_errors.String_kind)
        |
          cons
            (Tezos_protocol_environment_alpha__Environment.Micheline.Bytes loc _)
            _ =>
          __error_value
            (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_kind
              loc (cons Tezos_raw_protocol_alpha.Script_tc_errors.Prim_kind [])
              Tezos_raw_protocol_alpha.Script_tc_errors.Bytes_kind)
        |
          cons
            (Tezos_protocol_environment_alpha__Environment.Micheline.Seq loc _)
            _ =>
          __error_value
            (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_kind
              loc (cons Tezos_raw_protocol_alpha.Script_tc_errors.Prim_kind [])
              Tezos_raw_protocol_alpha.Script_tc_errors.Seq_kind)
        |
          cons
            (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
              Tezos_raw_protocol_alpha.Alpha_context.Script.K_parameter
              (cons arg []) annot) rest =>
          match p with
          | None => find_fields (Some (arg, loc, annot)) s c rest
          | Some _ =>
            __error_value
              (Tezos_protocol_environment_alpha__Environment.Error_monad.Duplicate_field
                loc Tezos_raw_protocol_alpha.Alpha_context.Script.K_parameter)
          end
        |
          cons
            (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
              Tezos_raw_protocol_alpha.Alpha_context.Script.K_storage
              (cons arg []) annot) rest =>
          match s with
          | None => find_fields p (Some (arg, loc, annot)) c rest
          | Some _ =>
            __error_value
              (Tezos_protocol_environment_alpha__Environment.Error_monad.Duplicate_field
                loc Tezos_raw_protocol_alpha.Alpha_context.Script.K_storage)
          end
        |
          cons
            (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
              Tezos_raw_protocol_alpha.Alpha_context.Script.K_code (cons arg [])
              annot) rest =>
          match c with
          | None => find_fields p s (Some (arg, loc, annot)) rest
          | Some _ =>
            __error_value
              (Tezos_protocol_environment_alpha__Environment.Error_monad.Duplicate_field
                loc Tezos_raw_protocol_alpha.Alpha_context.Script.K_code)
          end
        |
          cons
            (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
              ((Tezos_raw_protocol_alpha.Alpha_context.Script.K_parameter |
                Tezos_raw_protocol_alpha.Alpha_context.Script.K_storage |
                Tezos_raw_protocol_alpha.Alpha_context.Script.K_code) as name)
              args _) _ =>
          __error_value
            (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_arity
              loc name 1 (List.length args))
        |
          cons
            (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
              name _ _) _ =>
          let allowed :=
            cons Tezos_raw_protocol_alpha.Alpha_context.Script.K_parameter
              (cons Tezos_raw_protocol_alpha.Alpha_context.Script.K_storage
                (cons Tezos_raw_protocol_alpha.Alpha_context.Script.K_code []))
            in
          __error_value
            (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_primitive
              loc allowed name)
        end in
      op_gtgtquestion (find_fields None None None fields)
        (fun function_parameter =>
          match function_parameter with
          | (None, _, _) =>
            __error_value
              (Tezos_protocol_environment_alpha__Environment.Error_monad.Missing_field
                Tezos_raw_protocol_alpha.Alpha_context.Script.K_parameter)
          | (Some _, None, _) =>
            __error_value
              (Tezos_protocol_environment_alpha__Environment.Error_monad.Missing_field
                Tezos_raw_protocol_alpha.Alpha_context.Script.K_storage)
          | (Some _, Some _, None) =>
            __error_value
              (Tezos_protocol_environment_alpha__Environment.Error_monad.Missing_field
                Tezos_raw_protocol_alpha.Alpha_context.Script.K_code)
          |
            (Some (p, ploc, pannot), Some (s, sloc, sannot),
              Some (c, cloc, carrot)) =>
            let maybe_root_name :=
              op_gtgtquestion (Script_ir_annot.extract_field_annot p)
                (fun function_parameter =>
                  let '(p, root_name) := function_parameter in
                  match root_name with
                  | Some (Field_annot root_name) =>
                    ok (p, pannot, (Some root_name))
                  | None =>
                    match pannot with
                    | cons single [] =>
                      ok
                        (p, [],
                          (Some
                            (String.sub single 1
                              (op_minus (String.length single) 1))))
                    | _ => ok (p, pannot, None)
                    end
                  end) in
            if legacy then
              let '(p, root_name) :=
                match maybe_root_name with
                |
                  Tezos_protocol_environment_alpha__Environment.Pervasives.Ok
                    (p, _, root_name) => (p, root_name)
                |
                  Tezos_protocol_environment_alpha__Environment.Pervasives.Error
                    _ => (p, None)
                end in
              ok (p, s, c, root_name)
            else
              op_gtgtquestion maybe_root_name
                (fun function_parameter =>
                  let '(p, pannot, root_name) := function_parameter in
                  op_gtgtquestion
                    (Script_ir_annot.error_unexpected_annot ploc pannot)
                    (fun function_parameter =>
                      let 'tt := function_parameter in
                      op_gtgtquestion
                        (Script_ir_annot.error_unexpected_annot cloc carrot)
                        (fun function_parameter =>
                          let 'tt := function_parameter in
                          op_gtgtquestion
                            (Script_ir_annot.error_unexpected_annot sloc sannot)
                            (fun function_parameter =>
                              let 'tt := function_parameter in
                              ok (p, s, c, root_name)))))
          end)
    end.

Definition parse_script
  (type_logger : option type_logger)
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context) (legacy : bool)
  (function_parameter : Tezos_raw_protocol_alpha.Alpha_context.Script.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (ex_script * Tezos_raw_protocol_alpha.Alpha_context.context)) :=
  let '{|
    Tezos_raw_protocol_alpha.Alpha_context.Script.t.code := code;
      Tezos_raw_protocol_alpha.Alpha_context.Script.t.storage := storage
      |} := function_parameter in
  op_gtgteqquestion (Script.force_decode ctxt code)
    (fun function_parameter =>
      let '(code, ctxt) := function_parameter in
      op_gtgteqquestion (Script.force_decode ctxt storage)
        (fun function_parameter =>
          let '(storage, ctxt) := function_parameter in
          op_gtgteqquestion (op_atat Lwt.__return (parse_toplevel legacy code))
            (fun function_parameter =>
              let '(arg_type, storage_type, code_field, root_name) :=
                function_parameter in
              op_gtgteqquestion
                (trace
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.Ill_formed_type
                    (Some "parameter" % string) code (location arg_type))
                  (Lwt.__return (parse_parameter_ty ctxt legacy arg_type)))
                (fun function_parameter =>
                  let '(Ex_ty arg_type, ctxt) := function_parameter in
                  op_gtgteqquestion
                    (if legacy then
                      __return tt
                    else
                      Lwt.__return (well_formed_entrypoints arg_type root_name))
                    (fun function_parameter =>
                      let 'tt := function_parameter in
                      op_gtgteqquestion
                        (trace
                          (Tezos_protocol_environment_alpha__Environment.Error_monad.Ill_formed_type
                            (Some "storage" % string) code
                            (location storage_type))
                          (Lwt.__return
                            (parse_storage_ty ctxt legacy storage_type)))
                        (fun function_parameter =>
                          let '(Ex_ty storage_type, ctxt) := function_parameter
                            in
                          let arg_annot :=
                            default_annot default_param_annot
                              (type_to_var_annot (name_of_ty arg_type)) in
                          let storage_annot :=
                            default_annot default_storage_annot
                              (type_to_var_annot (name_of_ty storage_type)) in
                          let arg_type_full :=
                            Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t
                              (arg_type, None, arg_annot)
                              (storage_type, None, storage_annot) None
                              (op_pipepipe (has_big_map arg_type)
                                (has_big_map storage_type)) in
                          let ret_type_full :=
                            Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t
                              ((Tezos_raw_protocol_alpha.Script_typed_ir.List_t
                                (Tezos_raw_protocol_alpha.Script_typed_ir.Operation_t
                                  None) None false), None, None)
                              (storage_type, None, None) None
                              (has_big_map storage_type) in
                          op_gtgteqquestion
                            (trace_eval
                              (fun function_parameter =>
                                let 'tt := function_parameter in
                                op_gtgtpipequestion
                                  (op_atat Lwt.__return
                                    (serialize_ty_for_error ctxt storage_type))
                                  (fun function_parameter =>
                                    let '(storage_type, _ctxt) :=
                                      function_parameter in
                                    Tezos_protocol_environment_alpha__Environment.Error_monad.Ill_typed_data
                                      None storage storage_type))
                              (parse_data type_logger ctxt legacy storage_type
                                (root storage)))
                            (fun function_parameter =>
                              let '(storage, ctxt) := function_parameter in
                              op_gtgteqquestion
                                (trace
                                  (Tezos_protocol_environment_alpha__Environment.Error_monad.Ill_typed_contract
                                    code [])
                                  (parse_returning type_logger
                                    (Toplevel
                                      {|
                                        tc_context.Toplevel.storage_type :=
                                          storage_type;
                                        tc_context.Toplevel.param_type :=
                                          arg_type;
                                        tc_context.Toplevel.root_name :=
                                          root_name;
                                        tc_context.Toplevel.legacy_create_contract_literal :=
                                          false |}) ctxt legacy
                                    (arg_type_full, None) ret_type_full
                                    code_field))
                                (fun function_parameter =>
                                  let '(code, ctxt) := function_parameter in
                                  __return
                                    ((Ex_script
                                      {|
                                        Tezos_raw_protocol_alpha.Script_typed_ir.script.code :=
                                          code;
                                        Tezos_raw_protocol_alpha.Script_typed_ir.script.arg_type :=
                                          arg_type;
                                        Tezos_raw_protocol_alpha.Script_typed_ir.script.storage :=
                                          storage;
                                        Tezos_raw_protocol_alpha.Script_typed_ir.script.storage_type :=
                                          storage_type;
                                        Tezos_raw_protocol_alpha.Script_typed_ir.script.root_name :=
                                          root_name |}), ctxt))))))))).

Definition typecheck_code
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
  (code : Tezos_raw_protocol_alpha.Alpha_context.Script.expr)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Script_tc_errors.type_map *
        Tezos_raw_protocol_alpha.Alpha_context.context)) :=
  let legacy := false in
  op_gtgteqquestion (op_atat Lwt.__return (parse_toplevel legacy code))
    (fun function_parameter =>
      let '(arg_type, storage_type, code_field, root_name) := function_parameter
        in
      let type_map := __ref_value [] in
      op_gtgteqquestion
        (trace
          (Tezos_protocol_environment_alpha__Environment.Error_monad.Ill_formed_type
            (Some "parameter" % string) code (location arg_type))
          (Lwt.__return (parse_parameter_ty ctxt legacy arg_type)))
        (fun function_parameter =>
          let '(Ex_ty arg_type, ctxt) := function_parameter in
          op_gtgteqquestion
            (if legacy then
              __return tt
            else
              Lwt.__return (well_formed_entrypoints arg_type root_name))
            (fun function_parameter =>
              let 'tt := function_parameter in
              op_gtgteqquestion
                (trace
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.Ill_formed_type
                    (Some "storage" % string) code (location storage_type))
                  (Lwt.__return (parse_storage_ty ctxt legacy storage_type)))
                (fun function_parameter =>
                  let '(Ex_ty storage_type, ctxt) := function_parameter in
                  let arg_annot :=
                    default_annot default_param_annot
                      (type_to_var_annot (name_of_ty arg_type)) in
                  let storage_annot :=
                    default_annot default_storage_annot
                      (type_to_var_annot (name_of_ty storage_type)) in
                  let arg_type_full :=
                    Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t
                      (arg_type, None, arg_annot)
                      (storage_type, None, storage_annot) None
                      (op_pipepipe (has_big_map arg_type)
                        (has_big_map storage_type)) in
                  let ret_type_full :=
                    Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t
                      ((Tezos_raw_protocol_alpha.Script_typed_ir.List_t
                        (Tezos_raw_protocol_alpha.Script_typed_ir.Operation_t
                          None) None false), None, None)
                      (storage_type, None, None) None (has_big_map storage_type)
                    in
                  let __result_value :=
                    parse_returning
                      (Some
                        (fun loc =>
                          fun bef =>
                            fun aft =>
                              op_coloneq type_map
                                (cons (loc, (bef, aft))
                                  (op_exclamation type_map))))
                      (Toplevel
                        {| tc_context.Toplevel.storage_type := storage_type;
                          tc_context.Toplevel.param_type := arg_type;
                          tc_context.Toplevel.root_name := root_name;
                          tc_context.Toplevel.legacy_create_contract_literal :=
                            false |}) ctxt legacy (arg_type_full, None)
                      ret_type_full code_field in
                  op_gtgteqquestion
                    (trace
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.Ill_typed_contract
                        code (op_exclamation type_map)) __result_value)
                    (fun function_parameter =>
                      let
                        '(Tezos_raw_protocol_alpha.Script_typed_ir.Lam _ _, ctxt) :=
                        function_parameter in
                      __return ((op_exclamation type_map), ctxt)))))).

Definition typecheck_data
  (type_logger : option type_logger)
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
  (function_parameter :
    Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
      Tezos_raw_protocol_alpha.Alpha_context.Script.expr)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Alpha_context.context) :=
  let '(data, exp_ty) := function_parameter in
  let legacy := false in
  op_gtgteqquestion
    (trace
      (Tezos_protocol_environment_alpha__Environment.Error_monad.Ill_formed_type
        None exp_ty 0)
      (op_atat Lwt.__return (parse_packable_ty ctxt legacy (root exp_ty))))
    (fun function_parameter =>
      let '(Ex_ty exp_ty, ctxt) := function_parameter in
      op_gtgteqquestion
        (trace_eval
          (fun function_parameter =>
            let 'tt := function_parameter in
            op_gtgtpipequestion
              (op_atat Lwt.__return (serialize_ty_for_error ctxt exp_ty))
              (fun function_parameter =>
                let '(exp_ty, _ctxt) := function_parameter in
                Tezos_protocol_environment_alpha__Environment.Error_monad.Ill_typed_data
                  None data exp_ty))
          (parse_data type_logger ctxt legacy exp_ty (root data)))
        (fun function_parameter =>
          let '(_, ctxt) := function_parameter in
          __return ctxt)).

(* ❌ Applications of functors are not handled. *)
functor_application

Definition list_entrypoints {A : Set}
  (full : Tezos_raw_protocol_alpha.Script_typed_ir.ty A)
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
  (root_name : option Entrypoints_map.key)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (list (list Tezos_raw_protocol_alpha.Alpha_context.Script.prim) *
      Entrypoints_map.t
        (list Tezos_raw_protocol_alpha.Alpha_context.Script.prim *
          Tezos_raw_protocol_alpha.Alpha_context.Script.node)) :=
  let merge {B C : Set}
    (path : list B) (annot : option (* `Field_annot *) Entrypoints_map.key) (ty
    : Tezos_raw_protocol_alpha.Script_typed_ir.ty C) (reachable : bool)
    (function_parameter :
    list (list B) *
      Entrypoints_map.t
        (list B * Tezos_raw_protocol_alpha.Alpha_context.Script.node))
    : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (list (list B) *
        Entrypoints_map.t
          (list B * Tezos_raw_protocol_alpha.Alpha_context.Script.node)) :=
    let '(unreachables, all) as acc := function_parameter in
    match annot with
    | None | Some (Field_annot "" % string) =>
      op_atat ok
        (if reachable then
          acc
        else
          match ty with
          | Tezos_raw_protocol_alpha.Script_typed_ir.Union_t _ _ _ _ => acc
          | _ => ((cons (List.rev path) unreachables), all)
          end)
    | Some (Field_annot name) =>
      if op_gt (String.length name) 31 then
        ok ((cons (List.rev path) unreachables), all)
      else
        if Entrypoints_map.mem name all then
          ok ((cons (List.rev path) unreachables), all)
        else
          op_gtgtquestion (unparse_ty_no_lwt ctxt ty)
            (fun function_parameter =>
              let '(unparsed_ty, _) := function_parameter in
              ok
                (unreachables,
                  (Entrypoints_map.add name ((List.rev path), unparsed_ty) all)))
    end in
  let fix fold_tree {t : Set}
    (t : Tezos_raw_protocol_alpha.Script_typed_ir.ty t) (path :
    list Tezos_raw_protocol_alpha.Alpha_context.Script.prim) (reachable : bool)
    (acc :
    list (list Tezos_raw_protocol_alpha.Alpha_context.Script.prim) *
      Entrypoints_map.t
        (list Tezos_raw_protocol_alpha.Alpha_context.Script.prim *
          Tezos_raw_protocol_alpha.Alpha_context.Script.node))
    : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (list (list Tezos_raw_protocol_alpha.Alpha_context.Script.prim) *
        Entrypoints_map.t
          (list Tezos_raw_protocol_alpha.Alpha_context.Script.prim *
            Tezos_raw_protocol_alpha.Alpha_context.Script.node)) :=
    match t with
    | Tezos_raw_protocol_alpha.Script_typed_ir.Union_t (tl, al) (tr, ar) _ _ =>
      op_gtgtquestion
        (merge (cons Tezos_raw_protocol_alpha.Alpha_context.Script.D_Left path)
          al tl reachable acc)
        (fun acc =>
          op_gtgtquestion
            (merge
              (cons Tezos_raw_protocol_alpha.Alpha_context.Script.D_Right path)
              ar tr reachable acc)
            (fun acc =>
              op_gtgtquestion
                (fold_tree tl
                  (cons Tezos_raw_protocol_alpha.Alpha_context.Script.D_Left
                    path)
                  match al with
                  | Some _ => true
                  | None => reachable
                  end acc)
                (fun acc =>
                  fold_tree tr
                    (cons Tezos_raw_protocol_alpha.Alpha_context.Script.D_Right
                      path)
                    match ar with
                    | Some _ => true
                    | None => reachable
                    end acc)))
    | _ => ok acc
    end in
  op_gtgtquestion (unparse_ty_no_lwt ctxt full)
    (fun function_parameter =>
      let '(unparsed_full, _) := function_parameter in
      let '(init, reachable) :=
        match root_name with
        | None | Some "" % string => (Entrypoints_map.empty, false)
        | Some name =>
          ((Entrypoints_map.singleton name ([], unparsed_full)), true)
        end in
      fold_tree full [] reachable ([], init)).

Fixpoint unparse_data {a : Set}
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
  (mode : unparsing_mode) (ty : Tezos_raw_protocol_alpha.Script_typed_ir.ty a)
  (a : a)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Alpha_context.Script.node *
        Tezos_raw_protocol_alpha.Alpha_context.context)) :=
  op_gtgteqquestion (Lwt.__return (Gas.consume ctxt Unparse_costs.cycle))
    (fun ctxt =>
      match (ty, a) with
      | (Tezos_raw_protocol_alpha.Script_typed_ir.Unit_t _, tt) =>
        op_gtgteqquestion
          (Lwt.__return (Gas.consume ctxt Unparse_costs.__unit_value))
          (fun ctxt =>
            __return
              ((Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                (-1) Tezos_raw_protocol_alpha.Alpha_context.Script.D_Unit [] []),
                ctxt))
      | (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t _, v) =>
        op_gtgteqquestion
          (Lwt.__return (Gas.consume ctxt (Unparse_costs.int v)))
          (fun ctxt =>
            __return
              ((Tezos_protocol_environment_alpha__Environment.Micheline.Int (-1)
                (Script_int.to_zint v)), ctxt))
      | (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t _, v) =>
        op_gtgteqquestion
          (Lwt.__return (Gas.consume ctxt (Unparse_costs.int v)))
          (fun ctxt =>
            __return
              ((Tezos_protocol_environment_alpha__Environment.Micheline.Int (-1)
                (Script_int.to_zint v)), ctxt))
      | (Tezos_raw_protocol_alpha.Script_typed_ir.String_t _, s) =>
        op_gtgteqquestion
          (Lwt.__return (Gas.consume ctxt (Unparse_costs.__string_value s)))
          (fun ctxt =>
            __return
              ((Tezos_protocol_environment_alpha__Environment.Micheline.String
                (-1) s), ctxt))
      | (Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_t _, s) =>
        op_gtgteqquestion
          (Lwt.__return (Gas.consume ctxt (Unparse_costs.__bytes_value s)))
          (fun ctxt =>
            __return
              ((Tezos_protocol_environment_alpha__Environment.Micheline.Bytes
                (-1) s), ctxt))
      | (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t _, true) =>
        op_gtgteqquestion
          (Lwt.__return (Gas.consume ctxt Unparse_costs.__bool_value))
          (fun ctxt =>
            __return
              ((Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                (-1) Tezos_raw_protocol_alpha.Alpha_context.Script.D_True [] []),
                ctxt))
      | (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t _, false) =>
        op_gtgteqquestion
          (Lwt.__return (Gas.consume ctxt Unparse_costs.__bool_value))
          (fun ctxt =>
            __return
              ((Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                (-1) Tezos_raw_protocol_alpha.Alpha_context.Script.D_False [] []),
                ctxt))
      | (Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_t _, t) =>
        op_gtgteqquestion
          (Lwt.__return (Gas.consume ctxt (Unparse_costs.timestamp t)))
          (fun ctxt =>
            match mode with
            | Optimized =>
              __return
                ((Tezos_protocol_environment_alpha__Environment.Micheline.Int
                  (-1) (Script_timestamp.to_zint t)), ctxt)
            | Readable =>
              match Script_timestamp.to_notation t with
              | None =>
                __return
                  ((Tezos_protocol_environment_alpha__Environment.Micheline.Int
                    (-1) (Script_timestamp.to_zint t)), ctxt)
              | Some s =>
                __return
                  ((Tezos_protocol_environment_alpha__Environment.Micheline.String
                    (-1) s), ctxt)
              end
            end)
      | (Tezos_raw_protocol_alpha.Script_typed_ir.Address_t _, (c, entrypoint))
        =>
        op_gtgteqquestion
          (Lwt.__return (Gas.consume ctxt Unparse_costs.contract))
          (fun ctxt =>
            match mode with
            | Optimized =>
              let entrypoint :=
                match entrypoint with
                | "default" % string => "" % string
                | name => name
                end in
              let __bytes_value :=
                Data_encoding.Binary.to_bytes_exn
                  (tup2 Contract.encoding __Variable.__string_value)
                  (c, entrypoint) in
              __return
                ((Tezos_protocol_environment_alpha__Environment.Micheline.Bytes
                  (-1) __bytes_value), ctxt)
            | Readable =>
              let notation :=
                match entrypoint with
                | "default" % string => Contract.to_b58check c
                | entrypoint =>
                  op_caret (Contract.to_b58check c)
                    (op_caret "%" % string entrypoint)
                end in
              __return
                ((Tezos_protocol_environment_alpha__Environment.Micheline.String
                  (-1) notation), ctxt)
            end)
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Contract_t _ _,
          (_, (c, entrypoint))) =>
        op_gtgteqquestion
          (Lwt.__return (Gas.consume ctxt Unparse_costs.contract))
          (fun ctxt =>
            match mode with
            | Optimized =>
              let entrypoint :=
                match entrypoint with
                | "default" % string => "" % string
                | name => name
                end in
              let __bytes_value :=
                Data_encoding.Binary.to_bytes_exn
                  (tup2 Contract.encoding __Variable.__string_value)
                  (c, entrypoint) in
              __return
                ((Tezos_protocol_environment_alpha__Environment.Micheline.Bytes
                  (-1) __bytes_value), ctxt)
            | Readable =>
              let notation :=
                match entrypoint with
                | "default" % string => Contract.to_b58check c
                | entrypoint =>
                  op_caret (Contract.to_b58check c)
                    (op_caret "%" % string entrypoint)
                end in
              __return
                ((Tezos_protocol_environment_alpha__Environment.Micheline.String
                  (-1) notation), ctxt)
            end)
      | (Tezos_raw_protocol_alpha.Script_typed_ir.Signature_t _, s) =>
        op_gtgteqquestion
          (Lwt.__return (Gas.consume ctxt Unparse_costs.signature))
          (fun ctxt =>
            match mode with
            | Optimized =>
              let __bytes_value :=
                Data_encoding.Binary.to_bytes_exn Signature.encoding s in
              __return
                ((Tezos_protocol_environment_alpha__Environment.Micheline.Bytes
                  (-1) __bytes_value), ctxt)
            | Readable =>
              __return
                ((Tezos_protocol_environment_alpha__Environment.Micheline.String
                  (-1) (Signature.to_b58check s)), ctxt)
            end)
      | (Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_t _, v) =>
        op_gtgteqquestion (Lwt.__return (Gas.consume ctxt Unparse_costs.tez))
          (fun ctxt =>
            __return
              ((Tezos_protocol_environment_alpha__Environment.Micheline.Int (-1)
                (Z.of_int64 (Tez.to_mutez v))), ctxt))
      | (Tezos_raw_protocol_alpha.Script_typed_ir.Key_t _, k) =>
        op_gtgteqquestion (Lwt.__return (Gas.consume ctxt Unparse_costs.key))
          (fun ctxt =>
            match mode with
            | Optimized =>
              let __bytes_value :=
                Data_encoding.Binary.to_bytes_exn Signature.Public_key.encoding
                  k in
              __return
                ((Tezos_protocol_environment_alpha__Environment.Micheline.Bytes
                  (-1) __bytes_value), ctxt)
            | Readable =>
              __return
                ((Tezos_protocol_environment_alpha__Environment.Micheline.String
                  (-1) (Signature.Public_key.to_b58check k)), ctxt)
            end)
      | (Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_t _, k) =>
        op_gtgteqquestion
          (Lwt.__return (Gas.consume ctxt Unparse_costs.key_hash))
          (fun ctxt =>
            match mode with
            | Optimized =>
              let __bytes_value :=
                Data_encoding.Binary.to_bytes_exn
                  Signature.Public_key_hash.encoding k in
              __return
                ((Tezos_protocol_environment_alpha__Environment.Micheline.Bytes
                  (-1) __bytes_value), ctxt)
            | Readable =>
              __return
                ((Tezos_protocol_environment_alpha__Environment.Micheline.String
                  (-1) (Signature.Public_key_hash.to_b58check k)), ctxt)
            end)
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Operation_t _,
          (op, _big_map_diff)) =>
        let __bytes_value :=
          Data_encoding.Binary.to_bytes_exn
            Operation.internal_operation_encoding op in
        op_gtgteqquestion
          (Lwt.__return
            (Gas.consume ctxt (Unparse_costs.operation __bytes_value)))
          (fun ctxt =>
            __return
              ((Tezos_protocol_environment_alpha__Environment.Micheline.Bytes
                (-1) __bytes_value), ctxt))
      | (Tezos_raw_protocol_alpha.Script_typed_ir.Chain_id_t _, chain_id) =>
        let __bytes_value :=
          Data_encoding.Binary.to_bytes_exn Chain_id.encoding chain_id in
        op_gtgteqquestion
          (Lwt.__return
            (Gas.consume ctxt (Unparse_costs.chain_id __bytes_value)))
          (fun ctxt =>
            __return
              ((Tezos_protocol_environment_alpha__Environment.Micheline.Bytes
                (-1) __bytes_value), ctxt))
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t (tl, _, _) (tr, _, _) _
          _, (l, r)) =>
        op_gtgteqquestion (Lwt.__return (Gas.consume ctxt Unparse_costs.pair))
          (fun ctxt =>
            op_gtgteqquestion (unparse_data ctxt mode tl l)
              (fun function_parameter =>
                let '(l, ctxt) := function_parameter in
                op_gtgteqquestion (unparse_data ctxt mode tr r)
                  (fun function_parameter =>
                    let '(r, ctxt) := function_parameter in
                    __return
                      ((Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                        (-1)
                        Tezos_raw_protocol_alpha.Alpha_context.Script.D_Pair
                        (cons l (cons r [])) []), ctxt))))
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Union_t (tl, _) _ _ _,
          Tezos_raw_protocol_alpha.Script_typed_ir.L l) =>
        op_gtgteqquestion (Lwt.__return (Gas.consume ctxt Unparse_costs.union))
          (fun ctxt =>
            op_gtgteqquestion (unparse_data ctxt mode tl l)
              (fun function_parameter =>
                let '(l, ctxt) := function_parameter in
                __return
                  ((Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                    (-1) Tezos_raw_protocol_alpha.Alpha_context.Script.D_Left
                    (cons l []) []), ctxt)))
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Union_t _ (tr, _) _ _,
          Tezos_raw_protocol_alpha.Script_typed_ir.R r) =>
        op_gtgteqquestion (Lwt.__return (Gas.consume ctxt Unparse_costs.union))
          (fun ctxt =>
            op_gtgteqquestion (unparse_data ctxt mode tr r)
              (fun function_parameter =>
                let '(r, ctxt) := function_parameter in
                __return
                  ((Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                    (-1) Tezos_raw_protocol_alpha.Alpha_context.Script.D_Right
                    (cons r []) []), ctxt)))
      | (Tezos_raw_protocol_alpha.Script_typed_ir.Option_t t _ _, Some v) =>
        op_gtgteqquestion (Lwt.__return (Gas.consume ctxt Unparse_costs.some))
          (fun ctxt =>
            op_gtgteqquestion (unparse_data ctxt mode t v)
              (fun function_parameter =>
                let '(v, ctxt) := function_parameter in
                __return
                  ((Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                    (-1) Tezos_raw_protocol_alpha.Alpha_context.Script.D_Some
                    (cons v []) []), ctxt)))
      | (Tezos_raw_protocol_alpha.Script_typed_ir.Option_t _ _ _, None) =>
        op_gtgteqquestion (Lwt.__return (Gas.consume ctxt Unparse_costs.none))
          (fun ctxt =>
            __return
              ((Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                (-1) Tezos_raw_protocol_alpha.Alpha_context.Script.D_None [] []),
                ctxt))
      | (Tezos_raw_protocol_alpha.Script_typed_ir.List_t t _ _, items) =>
        op_gtgteqquestion
          (fold_left_s
            (fun function_parameter =>
              let '(l, ctxt) := function_parameter in
              fun element =>
                op_gtgteqquestion
                  (Lwt.__return (Gas.consume ctxt Unparse_costs.list_element))
                  (fun ctxt =>
                    op_gtgteqquestion (unparse_data ctxt mode t element)
                      (fun function_parameter =>
                        let '(unparsed, ctxt) := function_parameter in
                        __return ((cons unparsed l), ctxt)))) ([], ctxt) items)
          (fun function_parameter =>
            let '(items, ctxt) := function_parameter in
            __return
              ((Tezos_protocol_environment_alpha__Environment.Micheline.Seq (-1)
                (List.rev items)), ctxt))
      | (Tezos_raw_protocol_alpha.Script_typed_ir.Set_t t _, set) =>
        let t := ty_of_comparable_ty t in
        op_gtgteqquestion
          (fold_left_s
            (fun function_parameter =>
              let '(l, ctxt) := function_parameter in
              fun item =>
                op_gtgteqquestion
                  (Lwt.__return (Gas.consume ctxt Unparse_costs.set_element))
                  (fun ctxt =>
                    op_gtgteqquestion (unparse_data ctxt mode t item)
                      (fun function_parameter =>
                        let '(item, ctxt) := function_parameter in
                        __return ((cons item l), ctxt)))) ([], ctxt)
            (set_fold (fun e => fun acc => cons e acc) set []))
          (fun function_parameter =>
            let '(items, ctxt) := function_parameter in
            __return
              ((Tezos_protocol_environment_alpha__Environment.Micheline.Seq (-1)
                items), ctxt))
      | (Tezos_raw_protocol_alpha.Script_typed_ir.Map_t kt vt _ _, map) =>
        let kt := ty_of_comparable_ty kt in
        op_gtgteqquestion
          (fold_left_s
            (fun function_parameter =>
              let '(l, ctxt) := function_parameter in
              fun function_parameter =>
                let '(k, v) := function_parameter in
                op_gtgteqquestion
                  (Lwt.__return (Gas.consume ctxt Unparse_costs.map_element))
                  (fun ctxt =>
                    op_gtgteqquestion (unparse_data ctxt mode kt k)
                      (fun function_parameter =>
                        let '(key, ctxt) := function_parameter in
                        op_gtgteqquestion (unparse_data ctxt mode vt v)
                          (fun function_parameter =>
                            let '(value, ctxt) := function_parameter in
                            __return
                              ((cons
                                (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                  (-1)
                                  Tezos_raw_protocol_alpha.Alpha_context.Script.D_Elt
                                  (cons key (cons value [])) []) l), ctxt)))))
            ([], ctxt)
            (map_fold (fun k => fun v => fun acc => cons (k, v) acc) map []))
          (fun function_parameter =>
            let '(items, ctxt) := function_parameter in
            __return
              ((Tezos_protocol_environment_alpha__Environment.Micheline.Seq (-1)
                items), ctxt))
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Big_map_t kt vt _, {|
          Tezos_raw_protocol_alpha.Script_typed_ir.big_map.id := None;
            Tezos_raw_protocol_alpha.Script_typed_ir.big_map.diff := Diff
            |}) =>
        let Diff := projT2 Diff in
        let kt := ty_of_comparable_ty kt in
        op_gtgteqquestion
          (fold_left_s
            (fun function_parameter =>
              let '(l, ctxt) := function_parameter in
              fun function_parameter =>
                let '(k, v) := function_parameter in
                op_gtgteqquestion
                  (Lwt.__return (Gas.consume ctxt Unparse_costs.map_element))
                  (fun ctxt =>
                    op_gtgteqquestion (unparse_data ctxt mode kt k)
                      (fun function_parameter =>
                        let '(key, ctxt) := function_parameter in
                        op_gtgteqquestion (unparse_data ctxt mode vt v)
                          (fun function_parameter =>
                            let '(value, ctxt) := function_parameter in
                            __return
                              ((cons
                                (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                  (-1)
                                  Tezos_raw_protocol_alpha.Alpha_context.Script.D_Elt
                                  (cons key (cons value [])) []) l), ctxt)))))
            ([], ctxt)
            (Diff.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_map.OPS).(Tezos_protocol_environment_alpha__Environment.MAP.S.fold)
              (fun k =>
                fun v =>
                  fun acc =>
                    match v with
                    | None => acc
                    | Some v => cons (k, v) acc
                    end)
              (fst
                Diff.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_map.boxed))
              []))
          (fun function_parameter =>
            let '(items, ctxt) := function_parameter in
            __return
              ((Tezos_protocol_environment_alpha__Environment.Micheline.Seq (-1)
                items), ctxt))
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Big_map_t _kt _kv _, {|
          Tezos_raw_protocol_alpha.Script_typed_ir.big_map.id := Some id;
            Tezos_raw_protocol_alpha.Script_typed_ir.big_map.diff := Diff
            |}) =>
        let Diff := projT2 Diff in
        if
          op_eq
            (Diff.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_map.OPS).(Tezos_protocol_environment_alpha__Environment.MAP.S.cardinal)
              (fst
                Diff.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_map.boxed)))
            0 then
          __return
            ((Tezos_protocol_environment_alpha__Environment.Micheline.Int (-1)
              id), ctxt)
        else
          (* ❌ Assert instruction is not handled. *)
          assert false
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Lambda_t _ _ _,
          Tezos_raw_protocol_alpha.Script_typed_ir.Lam _ original_code) =>
        unparse_code ctxt mode original_code
      end)

with unparse_code
  (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
  (mode : unparsing_mode)
  : Tezos_raw_protocol_alpha.Alpha_context.Script.node ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_protocol_environment_alpha__Environment.Micheline.node Z
        Tezos_raw_protocol_alpha.Alpha_context.Script.prim *
        Tezos_raw_protocol_alpha__Alpha_context.context)) :=
  let legacy := true in
  fun function_parameter =>
    match function_parameter with
    |
      Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
        Tezos_raw_protocol_alpha.Alpha_context.Script.I_PUSH
        (cons ty (cons data [])) annot =>
      op_gtgteqquestion (Lwt.__return (parse_packable_ty ctxt legacy ty))
        (fun function_parameter =>
          let '(Ex_ty t, ctxt) := function_parameter in
          op_gtgteqquestion (parse_data None ctxt legacy t data)
            (fun function_parameter =>
              let '(data, ctxt) := function_parameter in
              op_gtgteqquestion (unparse_data ctxt mode t data)
                (fun function_parameter =>
                  let '(data, ctxt) := function_parameter in
                  op_gtgteqquestion
                    (Lwt.__return
                      (Gas.consume ctxt (Unparse_costs.prim_cost 2 annot)))
                    (fun ctxt =>
                      __return
                        ((Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                          loc
                          Tezos_raw_protocol_alpha.Alpha_context.Script.I_PUSH
                          (cons ty (cons data [])) annot), ctxt)))))
    | Tezos_protocol_environment_alpha__Environment.Micheline.Seq loc items =>
      op_gtgteqquestion
        (fold_left_s
          (fun function_parameter =>
            let '(l, ctxt) := function_parameter in
            fun item =>
              op_gtgteqquestion (unparse_code ctxt mode item)
                (fun function_parameter =>
                  let '(item, ctxt) := function_parameter in
                  __return ((cons item l), ctxt))) ([], ctxt) items)
        (fun function_parameter =>
          let '(items, ctxt) := function_parameter in
          op_gtgteqquestion
            (Lwt.__return
              (Gas.consume ctxt (Unparse_costs.seq_cost (List.length items))))
            (fun ctxt =>
              __return
                ((Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                  loc (List.rev items)), ctxt)))
    |
      Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc prim
        items annot =>
      op_gtgteqquestion
        (fold_left_s
          (fun function_parameter =>
            let '(l, ctxt) := function_parameter in
            fun item =>
              op_gtgteqquestion (unparse_code ctxt mode item)
                (fun function_parameter =>
                  let '(item, ctxt) := function_parameter in
                  __return ((cons item l), ctxt))) ([], ctxt) items)
        (fun function_parameter =>
          let '(items, ctxt) := function_parameter in
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt (Unparse_costs.prim_cost 3 annot)))
            (fun ctxt =>
              __return
                ((Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                  loc prim (List.rev items) annot), ctxt)))
    |
      (Tezos_protocol_environment_alpha__Environment.Micheline.Int _ _ |
        Tezos_protocol_environment_alpha__Environment.Micheline.String _ _ |
        Tezos_protocol_environment_alpha__Environment.Micheline.Bytes _ _) as
        atom => __return (atom, ctxt)
    end.

Definition unparse_script {A B : Set}
  (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
  (mode : unparsing_mode)
  (function_parameter : Tezos_raw_protocol_alpha.Script_typed_ir.script A B)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Alpha_context.Script.t *
        Tezos_raw_protocol_alpha__Alpha_context.context)) :=
  let '{|
    Tezos_raw_protocol_alpha.Script_typed_ir.script.code := code;
      Tezos_raw_protocol_alpha.Script_typed_ir.script.arg_type := arg_type;
      Tezos_raw_protocol_alpha.Script_typed_ir.script.storage := storage;
      Tezos_raw_protocol_alpha.Script_typed_ir.script.storage_type :=
        storage_type;
      Tezos_raw_protocol_alpha.Script_typed_ir.script.root_name := root_name
      |} := function_parameter in
  let 'Tezos_raw_protocol_alpha.Script_typed_ir.Lam _ original_code := code in
  op_gtgteqquestion (unparse_code ctxt mode original_code)
    (fun function_parameter =>
      let '(code, ctxt) := function_parameter in
      op_gtgteqquestion (unparse_data ctxt mode storage_type storage)
        (fun function_parameter =>
          let '(storage, ctxt) := function_parameter in
          op_gtgteqquestion (unparse_ty ctxt arg_type)
            (fun function_parameter =>
              let '(arg_type, ctxt) := function_parameter in
              op_gtgteqquestion (unparse_ty ctxt storage_type)
                (fun function_parameter =>
                  let '(storage_type, ctxt) := function_parameter in
                  let arg_type :=
                    add_field_annot
                      (Option.map
                        (fun n =>
                          (* ❌ Variants not supported *)
                          variant) root_name) None arg_type in
                  let code :=
                    Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                      (-1)
                      (cons
                        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                          (-1)
                          Tezos_raw_protocol_alpha.Alpha_context.Script.K_parameter
                          (cons arg_type []) [])
                        (cons
                          (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                            (-1)
                            Tezos_raw_protocol_alpha.Alpha_context.Script.K_storage
                            (cons storage_type []) [])
                          (cons
                            (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                              (-1)
                              Tezos_raw_protocol_alpha.Alpha_context.Script.K_code
                              (cons code []) []) []))) in
                  op_gtgteqquestion
                    (Lwt.__return
                      (op_gtgtquestion
                        (Gas.consume ctxt (Unparse_costs.seq_cost 3))
                        (fun ctxt =>
                          op_gtgtquestion
                            (Gas.consume ctxt (Unparse_costs.prim_cost 1 []))
                            (fun ctxt =>
                              op_gtgtquestion
                                (Gas.consume ctxt (Unparse_costs.prim_cost 1 []))
                                (fun ctxt =>
                                  Gas.consume ctxt
                                    (Unparse_costs.prim_cost 1 []))))))
                    (fun ctxt =>
                      __return
                        ({|
                          Tezos_raw_protocol_alpha.Alpha_context.Script.t.code :=
                            lazy_expr (strip_locations code);
                          Tezos_raw_protocol_alpha.Alpha_context.Script.t.storage :=
                            lazy_expr (strip_locations storage) |}, ctxt)))))).

Definition pack_data {A : Set}
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
  (typ : Tezos_raw_protocol_alpha.Script_typed_ir.ty A) (data : A)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_protocol_environment_alpha__Environment.MBytes.t *
        Tezos_raw_protocol_alpha__Alpha_context.context)) :=
  op_gtgteqquestion (unparse_data ctxt Optimized typ data)
    (fun function_parameter =>
      let '(unparsed, ctxt) := function_parameter in
      let __bytes_value :=
        Data_encoding.Binary.to_bytes_exn expr_encoding
          (Micheline.strip_locations unparsed) in
      op_gtgteqquestion
        (op_atat Lwt.__return
          (Gas.consume ctxt (Script.serialized_cost __bytes_value)))
        (fun ctxt =>
          let __bytes_value :=
            MBytes.concat "" % string
              (cons (MBytes.of_string "" % string) (cons __bytes_value [])) in
          op_gtgteqquestion
            (op_atat Lwt.__return
              (Gas.consume ctxt (Script.serialized_cost __bytes_value)))
            (fun ctxt => __return (__bytes_value, ctxt)))).

Definition hash_data {A : Set}
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
  (typ : Tezos_raw_protocol_alpha.Script_typed_ir.ty A) (data : A)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Script_expr_hash.t *
        Tezos_raw_protocol_alpha__Alpha_context.context)) :=
  op_gtgteqquestion (pack_data ctxt typ data)
    (fun function_parameter =>
      let '(__bytes_value, ctxt) := function_parameter in
      op_gtgteqquestion
        (op_atat Lwt.__return
          (Gas.consume ctxt
            (Michelson_v1_gas.Cost_of.Legacy.__hash_value __bytes_value
              Script_expr_hash.size)))
        (fun ctxt => __return ((hash_bytes None (cons __bytes_value [])), ctxt))).

Definition empty_big_map {A B : Set}
  (tk : Tezos_raw_protocol_alpha.Script_typed_ir.comparable_ty A)
  (tv : Tezos_raw_protocol_alpha.Script_typed_ir.ty B)
  : Tezos_raw_protocol_alpha.Script_typed_ir.big_map A B :=
  {| Tezos_raw_protocol_alpha.Script_typed_ir.big_map.id := None;
    Tezos_raw_protocol_alpha.Script_typed_ir.big_map.diff := empty_map tk;
    Tezos_raw_protocol_alpha.Script_typed_ir.big_map.key_type :=
      ty_of_comparable_ty tk;
    Tezos_raw_protocol_alpha.Script_typed_ir.big_map.value_type := tv |}.

Definition big_map_mem {A B : Set}
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context) (key : A)
  (function_parameter : Tezos_raw_protocol_alpha.Script_typed_ir.big_map A B)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (bool * Tezos_raw_protocol_alpha.Alpha_context.context)) :=
  let '{|
    Tezos_raw_protocol_alpha.Script_typed_ir.big_map.id := id;
      Tezos_raw_protocol_alpha.Script_typed_ir.big_map.diff := diff;
      Tezos_raw_protocol_alpha.Script_typed_ir.big_map.key_type := key_type
      |} := function_parameter in
  match ((map_get key diff), id) with
  | (None, None) => __return (false, ctxt)
  | (None, Some id) =>
    op_gtgteqquestion (hash_data ctxt key_type key)
      (fun function_parameter =>
        let '(__hash_value, ctxt) := function_parameter in
        op_gtgteqquestion (Alpha_context.Big_map.mem ctxt id __hash_value)
          (fun function_parameter =>
            let '(ctxt, res) := function_parameter in
            __return (res, ctxt)))
  | (Some None, _) => __return (false, ctxt)
  | (Some (Some _), _) => __return (true, ctxt)
  end.

Definition big_map_get {A B : Set}
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context) (key : A)
  (function_parameter : Tezos_raw_protocol_alpha.Script_typed_ir.big_map A B)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (option B * Tezos_raw_protocol_alpha.Alpha_context.context)) :=
  let '{|
    Tezos_raw_protocol_alpha.Script_typed_ir.big_map.id := id;
      Tezos_raw_protocol_alpha.Script_typed_ir.big_map.diff := diff;
      Tezos_raw_protocol_alpha.Script_typed_ir.big_map.key_type := key_type;
      Tezos_raw_protocol_alpha.Script_typed_ir.big_map.value_type := value_type
      |} := function_parameter in
  match ((map_get key diff), id) with
  | (Some x, _) => __return (x, ctxt)
  | (None, None) => __return (None, ctxt)
  | (None, Some id) =>
    op_gtgteqquestion (hash_data ctxt key_type key)
      (fun function_parameter =>
        let '(__hash_value, ctxt) := function_parameter in
        op_gtgteqquestion (Alpha_context.Big_map.get_opt ctxt id __hash_value)
          (fun function_parameter =>
            match function_parameter with
            | (ctxt, None) => __return (None, ctxt)
            | (ctxt, Some value) =>
              op_gtgteqquestion
                (parse_data None ctxt true value_type (Micheline.root value))
                (fun function_parameter =>
                  let '(x, ctxt) := function_parameter in
                  __return ((Some x), ctxt))
            end))
  end.

Definition big_map_update {A B : Set}
  (key : A) (value : option B)
  (function_parameter : Tezos_raw_protocol_alpha.Script_typed_ir.big_map A B)
  : Tezos_raw_protocol_alpha.Script_typed_ir.big_map A B :=
  let
    '{| Tezos_raw_protocol_alpha.Script_typed_ir.big_map.diff := diff |} as map :=
    function_parameter in
  (* ❌ Record substitution not handled *)
  record_substitution.

(* ❌ Applications of functors are not handled. *)
functor_application

Definition big_map_ids := Ids.t.

Definition no_big_map_id : Ids.t := Ids.empty.

Definition diff_of_big_map {A B : Set}
  (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
  (fresh :
    Tezos_raw_protocol_alpha__Alpha_context.context ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (Tezos_raw_protocol_alpha__Alpha_context.context *
          Tezos_raw_protocol_alpha__Alpha_context.Big_map.id)))
  (mode : unparsing_mode) (ids : Ids.t)
  (function_parameter : Tezos_raw_protocol_alpha.Script_typed_ir.big_map A B)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (list Tezos_raw_protocol_alpha.Alpha_context.Contract.big_map_diff_item *
        Tezos_raw_protocol_alpha__Alpha_context.Big_map.id *
        Tezos_raw_protocol_alpha__Alpha_context.context)) :=
  let '{|
    Tezos_raw_protocol_alpha.Script_typed_ir.big_map.id := id;
      Tezos_raw_protocol_alpha.Script_typed_ir.big_map.diff := diff;
      Tezos_raw_protocol_alpha.Script_typed_ir.big_map.key_type := key_type;
      Tezos_raw_protocol_alpha.Script_typed_ir.big_map.value_type := value_type
      |} := function_parameter in
  op_gtgteqquestion
    (Lwt.__return
      (Gas.consume ctxt (Michelson_v1_gas.Cost_of.Legacy.map_to_list diff)))
    (fun ctxt =>
      op_gtgteqquestion
        match id with
        | Some id =>
          if Ids.mem id ids then
            op_gtgteqquestion (fresh ctxt)
              (fun function_parameter =>
                let '(ctxt, duplicate) := function_parameter in
                __return
                  (ctxt,
                    (cons
                      (Tezos_raw_protocol_alpha.Alpha_context.Contract.Copy id
                        duplicate) []), duplicate))
          else
            __return (ctxt, [], id)
        | None =>
          op_gtgteqquestion (fresh ctxt)
            (fun function_parameter =>
              let '(ctxt, id) := function_parameter in
              op_gtgteqquestion (unparse_ty ctxt key_type)
                (fun function_parameter =>
                  let '(kt, ctxt) := function_parameter in
                  op_gtgteqquestion (unparse_ty ctxt value_type)
                    (fun function_parameter =>
                      let '(kv, ctxt) := function_parameter in
                      __return
                        (ctxt,
                          (cons
                            (Tezos_raw_protocol_alpha.Alpha_context.Contract.Alloc
                              {|
                                Tezos_raw_protocol_alpha.Alpha_context.Contract.big_map_diff_item.Alloc.big_map :=
                                  id;
                                Tezos_raw_protocol_alpha.Alpha_context.Contract.big_map_diff_item.Alloc.key_type :=
                                  Micheline.strip_locations kt;
                                Tezos_raw_protocol_alpha.Alpha_context.Contract.big_map_diff_item.Alloc.value_type :=
                                  Micheline.strip_locations kv |}) []), id))))
        end
        (fun function_parameter =>
          let '(ctxt, init, big_map) := function_parameter in
          let pairs :=
            map_fold (fun key => fun value => fun acc => cons (key, value) acc)
              diff [] in
          op_gtgteqquestion
            (fold_left_s
              (fun function_parameter =>
                let '(acc, ctxt) := function_parameter in
                fun function_parameter =>
                  let '(key, value) := function_parameter in
                  op_gtgteqquestion
                    (Lwt.__return (Gas.consume ctxt Typecheck_costs.cycle))
                    (fun ctxt =>
                      op_gtgteqquestion (hash_data ctxt key_type key)
                        (fun function_parameter =>
                          let '(diff_key_hash, ctxt) := function_parameter in
                          op_gtgteqquestion
                            (unparse_data ctxt mode key_type key)
                            (fun function_parameter =>
                              let '(key_node, ctxt) := function_parameter in
                              let diff_key := Micheline.strip_locations key_node
                                in
                              op_gtgteqquestion
                                match value with
                                | None => __return (None, ctxt)
                                | Some x =>
                                  op_gtgteqquestion
                                    (unparse_data ctxt mode value_type x)
                                    (fun function_parameter =>
                                      let '(node, ctxt) := function_parameter in
                                      __return
                                        ((Some (Micheline.strip_locations node)),
                                          ctxt))
                                end
                                (fun function_parameter =>
                                  let '(diff_value, ctxt) := function_parameter
                                    in
                                  let diff_item :=
                                    Tezos_raw_protocol_alpha.Alpha_context.Contract.Update
                                      {|
                                        Tezos_raw_protocol_alpha.Alpha_context.Contract.big_map_diff_item.Update.big_map :=
                                          big_map;
                                        Tezos_raw_protocol_alpha.Alpha_context.Contract.big_map_diff_item.Update.diff_key :=
                                          diff_key;
                                        Tezos_raw_protocol_alpha.Alpha_context.Contract.big_map_diff_item.Update.diff_key_hash :=
                                          diff_key_hash;
                                        Tezos_raw_protocol_alpha.Alpha_context.Contract.big_map_diff_item.Update.diff_value :=
                                          diff_value |} in
                                  __return ((cons diff_item acc), ctxt))))))
              ([], ctxt) pairs)
            (fun function_parameter =>
              let '(diff, ctxt) := function_parameter in
              __return ((op_at init diff), big_map, ctxt)))).

Fixpoint extract_big_map_updates {a : Set}
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
  (fresh :
    Tezos_raw_protocol_alpha.Alpha_context.context ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (Tezos_raw_protocol_alpha.Alpha_context.context *
          Tezos_raw_protocol_alpha.Alpha_context.Big_map.id)))
  (mode : unparsing_mode) (ids : Ids.t)
  (acc : list Tezos_raw_protocol_alpha.Alpha_context.Contract.big_map_diff)
  (ty : Tezos_raw_protocol_alpha.Script_typed_ir.ty a) (x : a)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Alpha_context.context * a * Ids.t *
        list Tezos_raw_protocol_alpha.Alpha_context.Contract.big_map_diff)) :=
  match (ty, x) with
  | (Tezos_raw_protocol_alpha.Script_typed_ir.Big_map_t _ _ _, map) =>
    op_gtgteqquestion (diff_of_big_map ctxt fresh mode ids map)
      (fun function_parameter =>
        let '(diff, id, ctxt) := function_parameter in
        let Map := Tezos_raw_protocol_alpha.Script_typed_ir.big_map.diff map in
        let Map := projT2 Map in
        let map :=
          (* ❌ Record substitution not handled *)
          record_substitution in
        __return (ctxt, map, (Ids.add id ids), (cons diff acc)))
  |
    (Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t (tyl, _, _) (tyr, _, _) _
      true, (xl, xr)) =>
    op_gtgteqquestion (Lwt.__return (Gas.consume ctxt Typecheck_costs.cycle))
      (fun ctxt =>
        op_gtgteqquestion
          (extract_big_map_updates ctxt fresh mode ids acc tyl xl)
          (fun function_parameter =>
            let '(ctxt, xl, ids, acc) := function_parameter in
            op_gtgteqquestion
              (extract_big_map_updates ctxt fresh mode ids acc tyr xr)
              (fun function_parameter =>
                let '(ctxt, xr, ids, acc) := function_parameter in
                __return (ctxt, (xl, xr), ids, acc))))
  |
    (Tezos_raw_protocol_alpha.Script_typed_ir.Union_t (ty, _) (_, _) _ true,
      Tezos_raw_protocol_alpha.Script_typed_ir.L x) =>
    op_gtgteqquestion (Lwt.__return (Gas.consume ctxt Typecheck_costs.cycle))
      (fun ctxt =>
        op_gtgteqquestion (extract_big_map_updates ctxt fresh mode ids acc ty x)
          (fun function_parameter =>
            let '(ctxt, x, ids, acc) := function_parameter in
            __return
              (ctxt, (Tezos_raw_protocol_alpha.Script_typed_ir.L x), ids, acc)))
  |
    (Tezos_raw_protocol_alpha.Script_typed_ir.Union_t (_, _) (ty, _) _ true,
      Tezos_raw_protocol_alpha.Script_typed_ir.R x) =>
    op_gtgteqquestion (Lwt.__return (Gas.consume ctxt Typecheck_costs.cycle))
      (fun ctxt =>
        op_gtgteqquestion (extract_big_map_updates ctxt fresh mode ids acc ty x)
          (fun function_parameter =>
            let '(ctxt, x, ids, acc) := function_parameter in
            __return
              (ctxt, (Tezos_raw_protocol_alpha.Script_typed_ir.R x), ids, acc)))
  | (Tezos_raw_protocol_alpha.Script_typed_ir.Option_t ty _ true, Some x) =>
    op_gtgteqquestion (Lwt.__return (Gas.consume ctxt Typecheck_costs.cycle))
      (fun ctxt =>
        op_gtgteqquestion (extract_big_map_updates ctxt fresh mode ids acc ty x)
          (fun function_parameter =>
            let '(ctxt, x, ids, acc) := function_parameter in
            __return (ctxt, (Some x), ids, acc)))
  | (Tezos_raw_protocol_alpha.Script_typed_ir.List_t ty _ true, l) =>
    op_gtgteqquestion
      (fold_left_s
        (fun function_parameter =>
          let '(ctxt, l, ids, acc) := function_parameter in
          fun x =>
            op_gtgteqquestion
              (Lwt.__return (Gas.consume ctxt Typecheck_costs.cycle))
              (fun ctxt =>
                op_gtgteqquestion
                  (extract_big_map_updates ctxt fresh mode ids acc ty x)
                  (fun function_parameter =>
                    let '(ctxt, x, ids, acc) := function_parameter in
                    __return (ctxt, (cons x l), ids, acc))))
        (ctxt, [], ids, acc) l)
      (fun function_parameter =>
        let '(ctxt, l, ids, acc) := function_parameter in
        __return (ctxt, (List.rev l), ids, acc))
  | (Tezos_raw_protocol_alpha.Script_typed_ir.Map_t _ ty _ true, M as m) =>
    let M := projT2 M in
    op_gtgteqquestion
      (Lwt.__return
        (Gas.consume ctxt (Michelson_v1_gas.Cost_of.Legacy.map_to_list m)))
      (fun ctxt =>
        op_gtgteqquestion
          (fold_left_s
            (fun function_parameter =>
              let '(ctxt, m, ids, acc) := function_parameter in
              fun function_parameter =>
                let '(k, x) := function_parameter in
                op_gtgteqquestion
                  (Lwt.__return (Gas.consume ctxt Typecheck_costs.cycle))
                  (fun ctxt =>
                    op_gtgteqquestion
                      (extract_big_map_updates ctxt fresh mode ids acc ty x)
                      (fun function_parameter =>
                        let '(ctxt, x, ids, acc) := function_parameter in
                        __return
                          (ctxt,
                            (M.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_map.OPS).(Tezos_protocol_environment_alpha__Environment.MAP.S.add)
                              k x m), ids, acc))))
            (ctxt,
              M.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_map.OPS).(Tezos_protocol_environment_alpha__Environment.MAP.S.empty),
              ids, acc)
            (M.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_map.OPS).(Tezos_protocol_environment_alpha__Environment.MAP.S.bindings)
              (fst M.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_map.boxed))))
          (fun function_parameter =>
            let '(ctxt, m, ids, acc) := function_parameter in
            let M :=
              (* ❌ The signature name of this module could not be found *)
              existT _ _
                {|
                  unknown_signature_name.OPS :=
                    M.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_map.OPS);
                  unknown_signature_name.key_ty :=
                    M.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_map.key_ty);
                  unknown_signature_name.boxed :=
                    (m,
                      (snd
                        M.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_map.boxed)))
                  |} in
            __return (ctxt, M, ids, acc)))
  | (Tezos_raw_protocol_alpha.Script_typed_ir.Option_t _ _ true, None) =>
    __return (ctxt, None, ids, acc)
  | (Tezos_raw_protocol_alpha.Script_typed_ir.List_t _ _ false, v) =>
    __return (ctxt, v, ids, acc)
  | (Tezos_raw_protocol_alpha.Script_typed_ir.Map_t _ _ _ false, v) =>
    __return (ctxt, v, ids, acc)
  | (Tezos_raw_protocol_alpha.Script_typed_ir.Option_t _ _ false, None) =>
    __return (ctxt, None, ids, acc)
  | (Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t _ _ _ false, v) =>
    __return (ctxt, v, ids, acc)
  | (Tezos_raw_protocol_alpha.Script_typed_ir.Union_t _ _ _ false, v) =>
    __return (ctxt, v, ids, acc)
  | (Tezos_raw_protocol_alpha.Script_typed_ir.Option_t _ _ false, v) =>
    __return (ctxt, v, ids, acc)
  | (Tezos_raw_protocol_alpha.Script_typed_ir.Chain_id_t _, v) =>
    __return (ctxt, v, ids, acc)
  | (Tezos_raw_protocol_alpha.Script_typed_ir.Set_t _ _, v) =>
    __return (ctxt, v, ids, acc)
  | (Tezos_raw_protocol_alpha.Script_typed_ir.Unit_t _, v) =>
    __return (ctxt, v, ids, acc)
  | (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t _, v) =>
    __return (ctxt, v, ids, acc)
  | (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t _, v) =>
    __return (ctxt, v, ids, acc)
  | (Tezos_raw_protocol_alpha.Script_typed_ir.Signature_t _, v) =>
    __return (ctxt, v, ids, acc)
  | (Tezos_raw_protocol_alpha.Script_typed_ir.String_t _, v) =>
    __return (ctxt, v, ids, acc)
  | (Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_t _, v) =>
    __return (ctxt, v, ids, acc)
  | (Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_t _, v) =>
    __return (ctxt, v, ids, acc)
  | (Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_t _, v) =>
    __return (ctxt, v, ids, acc)
  | (Tezos_raw_protocol_alpha.Script_typed_ir.Key_t _, v) =>
    __return (ctxt, v, ids, acc)
  | (Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_t _, v) =>
    __return (ctxt, v, ids, acc)
  | (Tezos_raw_protocol_alpha.Script_typed_ir.Address_t _, v) =>
    __return (ctxt, v, ids, acc)
  | (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t _, v) =>
    __return (ctxt, v, ids, acc)
  | (Tezos_raw_protocol_alpha.Script_typed_ir.Lambda_t _ _ _, v) =>
    __return (ctxt, v, ids, acc)
  | (Tezos_raw_protocol_alpha.Script_typed_ir.Contract_t _ _, v) =>
    __return (ctxt, v, ids, acc)
  | (Tezos_raw_protocol_alpha.Script_typed_ir.Operation_t _, _) =>
    (* ❌ Assert instruction is not handled. *)
    assert false
  end.

Definition collect_big_maps {A : Set}
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
  (ty : Tezos_raw_protocol_alpha.Script_typed_ir.ty A) (x : A)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Ids.t * Tezos_raw_protocol_alpha.Alpha_context.context)) :=
  let fix collect {a : Set}
    (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context) (ty :
    Tezos_raw_protocol_alpha.Script_typed_ir.ty a) (x : a) (acc : Ids.t)
    : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Ids.t * Tezos_raw_protocol_alpha.Alpha_context.context) :=
    match (ty, x) with
    |
      (Tezos_raw_protocol_alpha.Script_typed_ir.Big_map_t _ _ _, {|
        Tezos_raw_protocol_alpha.Script_typed_ir.big_map.id := Some id |})
      =>
      op_gtgtquestion (Gas.consume ctxt Typecheck_costs.cycle)
        (fun ctxt => ok ((Ids.add id acc), ctxt))
    |
      (Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t (tyl, _, _) (tyr, _, _) _
        true, (xl, xr)) =>
      op_gtgtquestion (collect ctxt tyl xl acc)
        (fun function_parameter =>
          let '(acc, ctxt) := function_parameter in
          collect ctxt tyr xr acc)
    |
      (Tezos_raw_protocol_alpha.Script_typed_ir.Union_t (ty, _) (_, _) _ true,
        Tezos_raw_protocol_alpha.Script_typed_ir.L x) => collect ctxt ty x acc
    |
      (Tezos_raw_protocol_alpha.Script_typed_ir.Union_t (_, _) (ty, _) _ true,
        Tezos_raw_protocol_alpha.Script_typed_ir.R x) => collect ctxt ty x acc
    | (Tezos_raw_protocol_alpha.Script_typed_ir.Option_t ty _ true, Some x) =>
      collect ctxt ty x acc
    | (Tezos_raw_protocol_alpha.Script_typed_ir.List_t ty _ true, l) =>
      List.fold_left
        (fun acc =>
          fun x =>
            op_gtgtquestion acc
              (fun function_parameter =>
                let '(acc, ctxt) := function_parameter in
                collect ctxt ty x acc)) (ok (acc, ctxt)) l
    | (Tezos_raw_protocol_alpha.Script_typed_ir.Map_t _ ty _ true, m) =>
      map_fold
        (fun function_parameter =>
          let '_ := function_parameter in
          fun v =>
            fun acc =>
              op_gtgtquestion acc
                (fun function_parameter =>
                  let '(acc, ctxt) := function_parameter in
                  collect ctxt ty v acc)) m (ok (acc, ctxt))
    | (Tezos_raw_protocol_alpha.Script_typed_ir.List_t _ _ false, _) =>
      ok (acc, ctxt)
    | (Tezos_raw_protocol_alpha.Script_typed_ir.Map_t _ _ _ false, _) =>
      ok (acc, ctxt)
    |
      (Tezos_raw_protocol_alpha.Script_typed_ir.Big_map_t _ _ _, {|
        Tezos_raw_protocol_alpha.Script_typed_ir.big_map.id := None |}) =>
      ok (acc, ctxt)
    | (Tezos_raw_protocol_alpha.Script_typed_ir.Option_t _ _ true, None) =>
      ok (acc, ctxt)
    | (Tezos_raw_protocol_alpha.Script_typed_ir.Option_t _ _ false, _) =>
      ok (acc, ctxt)
    | (Tezos_raw_protocol_alpha.Script_typed_ir.Union_t _ _ _ false, _) =>
      ok (acc, ctxt)
    | (Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t _ _ _ false, _) =>
      ok (acc, ctxt)
    | (Tezos_raw_protocol_alpha.Script_typed_ir.Chain_id_t _, _) =>
      ok (acc, ctxt)
    | (Tezos_raw_protocol_alpha.Script_typed_ir.Set_t _ _, _) => ok (acc, ctxt)
    | (Tezos_raw_protocol_alpha.Script_typed_ir.Unit_t _, _) => ok (acc, ctxt)
    | (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t _, _) => ok (acc, ctxt)
    | (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t _, _) => ok (acc, ctxt)
    | (Tezos_raw_protocol_alpha.Script_typed_ir.Signature_t _, _) =>
      ok (acc, ctxt)
    | (Tezos_raw_protocol_alpha.Script_typed_ir.String_t _, _) => ok (acc, ctxt)
    | (Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_t _, _) => ok (acc, ctxt)
    | (Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_t _, _) => ok (acc, ctxt)
    | (Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_t _, _) =>
      ok (acc, ctxt)
    | (Tezos_raw_protocol_alpha.Script_typed_ir.Key_t _, _) => ok (acc, ctxt)
    | (Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_t _, _) =>
      ok (acc, ctxt)
    | (Tezos_raw_protocol_alpha.Script_typed_ir.Address_t _, _) =>
      ok (acc, ctxt)
    | (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t _, _) => ok (acc, ctxt)
    | (Tezos_raw_protocol_alpha.Script_typed_ir.Lambda_t _ _ _, _) =>
      ok (acc, ctxt)
    | (Tezos_raw_protocol_alpha.Script_typed_ir.Contract_t _ _, _) =>
      ok (acc, ctxt)
    | (Tezos_raw_protocol_alpha.Script_typed_ir.Operation_t _, _) =>
      (* ❌ Assert instruction is not handled. *)
      assert false
    end in
  Lwt.__return (collect ctxt ty x no_big_map_id).

Definition extract_big_map_diff {A : Set}
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
  (mode : unparsing_mode) (temporary : bool) (to_duplicate : Ids.t)
  (to_update : Ids.t) (ty : Tezos_raw_protocol_alpha.Script_typed_ir.ty A)
  (v : A)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (A *
        option
          (list
            Tezos_raw_protocol_alpha.Alpha_context.Contract.big_map_diff_item) *
        Tezos_raw_protocol_alpha.Alpha_context.context)) :=
  let to_duplicate := Ids.diff to_duplicate to_update in
  let fresh :=
    if temporary then
      fun c => __return (Big_map.fresh_temporary c)
    else
      Big_map.fresh in
  op_gtgteqquestion
    (extract_big_map_updates ctxt fresh mode to_duplicate [] ty v)
    (fun function_parameter =>
      let '(ctxt, v, alive, diffs) := function_parameter in
      let diffs :=
        if temporary then
          diffs
        else
          let dead := Ids.diff to_update alive in
          cons
            (Ids.fold
              (fun id =>
                fun acc =>
                  cons
                    (Tezos_raw_protocol_alpha.Alpha_context.Contract.Clear id)
                    acc) dead []) diffs in
      match diffs with
      | [] => __return (v, None, ctxt)
      | diffs => __return (v, (Some (List.flatten diffs)), ctxt)
      end).

Definition list_of_big_map_ids (ids : Ids.t) : list Ids.elt := Ids.elements ids.

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Alpha_context
open Script_tc_errors

type ('ta, 'tb) eq = Eq : ('same, 'same) eq

type ex_comparable_ty =
  | Ex_comparable_ty : 'a Script_typed_ir.comparable_ty -> ex_comparable_ty

type ex_ty = Ex_ty : 'a Script_typed_ir.ty -> ex_ty

type ex_stack_ty = Ex_stack_ty : 'a Script_typed_ir.stack_ty -> ex_stack_ty

type ex_script = Ex_script : ('a, 'b) Script_typed_ir.script -> ex_script

type tc_context =
  | Lambda : tc_context
  | Dip : 'a Script_typed_ir.stack_ty * tc_context -> tc_context
  | Toplevel : {
      storage_type : 'sto Script_typed_ir.ty;
      param_type : 'param Script_typed_ir.ty;
      root_name : string option;
      legacy_create_contract_literal : bool;
    }
      -> tc_context

type 'bef judgement =
  | Typed : ('bef, 'aft) Script_typed_ir.descr -> 'bef judgement
  | Failed : {
      descr :
        'aft. 'aft Script_typed_ir.stack_ty ->
        ('bef, 'aft) Script_typed_ir.descr;
    }
      -> 'bef judgement

type unparsing_mode = Optimized | Readable

type type_logger =
  int ->
  (Script.expr * Script.annot) list ->
  (Script.expr * Script.annot) list ->
  unit

(* ---- Sets and Maps -------------------------------------------------------*)

val empty_set : 'a Script_typed_ir.comparable_ty -> 'a Script_typed_ir.set

val set_fold :
  ('elt -> 'acc -> 'acc) -> 'elt Script_typed_ir.set -> 'acc -> 'acc

val set_update : 'a -> bool -> 'a Script_typed_ir.set -> 'a Script_typed_ir.set

val set_mem : 'elt -> 'elt Script_typed_ir.set -> bool

val set_size : 'elt Script_typed_ir.set -> Script_int.n Script_int.num

val empty_map :
  'a Script_typed_ir.comparable_ty -> ('a, 'b) Script_typed_ir.map

val map_fold :
  ('key -> 'value -> 'acc -> 'acc) ->
  ('key, 'value) Script_typed_ir.map ->
  'acc ->
  'acc

val map_update :
  'a ->
  'b option ->
  ('a, 'b) Script_typed_ir.map ->
  ('a, 'b) Script_typed_ir.map

val map_mem : 'key -> ('key, 'value) Script_typed_ir.map -> bool

val map_get : 'key -> ('key, 'value) Script_typed_ir.map -> 'value option

val map_key_ty :
  ('a, 'b) Script_typed_ir.map -> 'a Script_typed_ir.comparable_ty

val map_size : ('a, 'b) Script_typed_ir.map -> Script_int.n Script_int.num

val empty_big_map :
  'a Script_typed_ir.comparable_ty ->
  'b Script_typed_ir.ty ->
  ('a, 'b) Script_typed_ir.big_map

val big_map_mem :
  context ->
  'key ->
  ('key, 'value) Script_typed_ir.big_map ->
  (bool * context) tzresult Lwt.t

val big_map_get :
  context ->
  'key ->
  ('key, 'value) Script_typed_ir.big_map ->
  ('value option * context) tzresult Lwt.t

val big_map_update :
  'key ->
  'value option ->
  ('key, 'value) Script_typed_ir.big_map ->
  ('key, 'value) Script_typed_ir.big_map

val ty_eq :
  context ->
  'ta Script_typed_ir.ty ->
  'tb Script_typed_ir.ty ->
  (('ta Script_typed_ir.ty, 'tb Script_typed_ir.ty) eq * context) tzresult

val compare_comparable : 'a Script_typed_ir.comparable_ty -> 'a -> 'a -> int

val parse_data :
  ?type_logger:type_logger ->
  context ->
  legacy:bool ->
  'a Script_typed_ir.ty ->
  Script.node ->
  ('a * context) tzresult Lwt.t

val unparse_data :
  context ->
  unparsing_mode ->
  'a Script_typed_ir.ty ->
  'a ->
  (Script.node * context) tzresult Lwt.t

val parse_instr :
  ?type_logger:type_logger ->
  tc_context ->
  context ->
  legacy:bool ->
  Script.node ->
  'bef Script_typed_ir.stack_ty ->
  ('bef judgement * context) tzresult Lwt.t

val parse_ty :
  context ->
  legacy:bool ->
  allow_big_map:bool ->
  allow_operation:bool ->
  allow_contract:bool ->
  Script.node ->
  (ex_ty * context) tzresult

val parse_packable_ty :
  context -> legacy:bool -> Script.node -> (ex_ty * context) tzresult

val unparse_ty :
  context -> 'a Script_typed_ir.ty -> (Script.node * context) tzresult Lwt.t

val parse_toplevel :
  legacy:bool ->
  Script.expr ->
  (Script.node * Script.node * Script.node * string option) tzresult

val add_field_annot :
  [`Field_annot of string] option ->
  [`Var_annot of string] option ->
  Script.node ->
  Script.node

val typecheck_code :
  context -> Script.expr -> (type_map * context) tzresult Lwt.t

val typecheck_data :
  ?type_logger:type_logger ->
  context ->
  Script.expr * Script.expr ->
  context tzresult Lwt.t

val parse_script :
  ?type_logger:type_logger ->
  context ->
  legacy:bool ->
  Script.t ->
  (ex_script * context) tzresult Lwt.t

(* Gas accounting may not be perfect in this function, as it is only called by RPCs. *)
val unparse_script :
  context ->
  unparsing_mode ->
  ('a, 'b) Script_typed_ir.script ->
  (Script.t * context) tzresult Lwt.t

val parse_contract :
  legacy:bool ->
  context ->
  Script.location ->
  'a Script_typed_ir.ty ->
  Contract.t ->
  entrypoint:string ->
  (context * 'a Script_typed_ir.typed_contract) tzresult Lwt.t

val parse_contract_for_script :
  legacy:bool ->
  context ->
  Script.location ->
  'a Script_typed_ir.ty ->
  Contract.t ->
  entrypoint:string ->
  (context * 'a Script_typed_ir.typed_contract option) tzresult Lwt.t

val find_entrypoint :
  't Script_typed_ir.ty ->
  root_name:string option ->
  string ->
  ((Script.node -> Script.node) * ex_ty) tzresult

module Entrypoints_map : S.MAP with type key = string

val list_entrypoints :
  't Script_typed_ir.ty ->
  context ->
  root_name:string option ->
  ( Michelson_v1_primitives.prim list list
  * (Michelson_v1_primitives.prim list * Script.node) Entrypoints_map.t )
  tzresult

val pack_data :
  context -> 'a Script_typed_ir.ty -> 'a -> (MBytes.t * context) tzresult Lwt.t

val hash_data :
  context ->
  'a Script_typed_ir.ty ->
  'a ->
  (Script_expr_hash.t * context) tzresult Lwt.t

type big_map_ids

val no_big_map_id : big_map_ids

val collect_big_maps :
  context ->
  'a Script_typed_ir.ty ->
  'a ->
  (big_map_ids * context) tzresult Lwt.t

val list_of_big_map_ids : big_map_ids -> Z.t list

val extract_big_map_diff :
  context ->
  unparsing_mode ->
  temporary:bool ->
  to_duplicate:big_map_ids ->
  to_update:big_map_ids ->
  'a Script_typed_ir.ty ->
  'a ->
  ('a * Contract.big_map_diff option * context) tzresult Lwt.t

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Reserved Notation "'eq".

Inductive eq_gadt : Set :=
| Eq : eq_gadt

where "'eq" := (fun (ta tb : Set) => eq_gadt).

Definition eq := 'eq.

Reserved Notation "'ex_comparable_ty".

Inductive ex_comparable_ty_gadt : Set :=
| Ex_comparable_ty : forall {a : Set},
  Tezos_raw_protocol_alpha.Script_typed_ir.comparable_ty a ->
  ex_comparable_ty_gadt

where "'ex_comparable_ty" := (ex_comparable_ty_gadt).

Definition ex_comparable_ty := 'ex_comparable_ty.

Reserved Notation "'ex_ty".

Inductive ex_ty_gadt : Set :=
| Ex_ty : forall {a : Set},
  Tezos_raw_protocol_alpha.Script_typed_ir.ty a -> ex_ty_gadt

where "'ex_ty" := (ex_ty_gadt).

Definition ex_ty := 'ex_ty.

Reserved Notation "'ex_stack_ty".

Inductive ex_stack_ty_gadt : Set :=
| Ex_stack_ty : forall {a : Set},
  Tezos_raw_protocol_alpha.Script_typed_ir.stack_ty a -> ex_stack_ty_gadt

where "'ex_stack_ty" := (ex_stack_ty_gadt).

Definition ex_stack_ty := 'ex_stack_ty.

Reserved Notation "'ex_script".

Inductive ex_script_gadt : Set :=
| Ex_script : forall {a b : Set},
  Tezos_raw_protocol_alpha.Script_typed_ir.script a b -> ex_script_gadt

where "'ex_script" := (ex_script_gadt).

Definition ex_script := 'ex_script.

Reserved Notation "'tc_context".

Inductive tc_context_gadt : Set :=
| Lambda : tc_context_gadt
| Dip : forall {a : Set},
  Tezos_raw_protocol_alpha.Script_typed_ir.stack_ty a -> tc_context_gadt ->
  tc_context_gadt
| Toplevel : forall {param sto : Set},
  Tezos_raw_protocol_alpha.Script_typed_ir.ty sto ->
  Tezos_raw_protocol_alpha.Script_typed_ir.ty param -> option string -> bool ->
  tc_context_gadt

where "'tc_context" := (tc_context_gadt).

Definition tc_context := 'tc_context.

Reserved Notation "'judgement".

Inductive judgement_gadt : Set :=
| Typed : forall {aft bef : Set},
  Tezos_raw_protocol_alpha.Script_typed_ir.descr bef aft -> judgement_gadt
| Failed : forall {aft bef : Set},
  (Tezos_raw_protocol_alpha.Script_typed_ir.stack_ty aft ->
  Tezos_raw_protocol_alpha.Script_typed_ir.descr bef aft) * aft ->
  judgement_gadt

where "'judgement" := (fun (bef : Set) => judgement_gadt).

Definition judgement := 'judgement.

Inductive unparsing_mode : Set :=
| Optimized : unparsing_mode
| Readable : unparsing_mode.

Definition type_logger :=
  Z ->
  list
    (Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
      Tezos_raw_protocol_alpha.Alpha_context.Script.annot) ->
  list
    (Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
      Tezos_raw_protocol_alpha.Alpha_context.Script.annot) -> unit.

Parameter empty_set : forall {a : Set},
  Tezos_raw_protocol_alpha.Script_typed_ir.comparable_ty a ->
  Tezos_raw_protocol_alpha.Script_typed_ir.set a.

Parameter set_fold : forall {acc elt : Set},
  (elt -> acc -> acc) -> Tezos_raw_protocol_alpha.Script_typed_ir.set elt ->
  acc -> acc.

Parameter set_update : forall {a : Set},
  a -> bool -> Tezos_raw_protocol_alpha.Script_typed_ir.set a ->
  Tezos_raw_protocol_alpha.Script_typed_ir.set a.

Parameter set_mem : forall {elt : Set},
  elt -> Tezos_raw_protocol_alpha.Script_typed_ir.set elt -> bool.

Parameter set_size : forall {elt : Set},
  Tezos_raw_protocol_alpha.Script_typed_ir.set elt ->
  Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
    Tezos_raw_protocol_alpha.Alpha_context.Script_int.n.

Parameter empty_map : forall {a b : Set},
  Tezos_raw_protocol_alpha.Script_typed_ir.comparable_ty a ->
  Tezos_raw_protocol_alpha.Script_typed_ir.map a b.

Parameter map_fold : forall {acc key value : Set},
  (key -> value -> acc -> acc) ->
  Tezos_raw_protocol_alpha.Script_typed_ir.map key value -> acc -> acc.

Parameter map_update : forall {a b : Set},
  a -> option b -> Tezos_raw_protocol_alpha.Script_typed_ir.map a b ->
  Tezos_raw_protocol_alpha.Script_typed_ir.map a b.

Parameter map_mem : forall {key value : Set},
  key -> Tezos_raw_protocol_alpha.Script_typed_ir.map key value -> bool.

Parameter map_get : forall {key value : Set},
  key -> Tezos_raw_protocol_alpha.Script_typed_ir.map key value -> option value.

Parameter map_key_ty : forall {a b : Set},
  Tezos_raw_protocol_alpha.Script_typed_ir.map a b ->
  Tezos_raw_protocol_alpha.Script_typed_ir.comparable_ty a.

Parameter map_size : forall {a b : Set},
  Tezos_raw_protocol_alpha.Script_typed_ir.map a b ->
  Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
    Tezos_raw_protocol_alpha.Alpha_context.Script_int.n.

Parameter empty_big_map : forall {a b : Set},
  Tezos_raw_protocol_alpha.Script_typed_ir.comparable_ty a ->
  Tezos_raw_protocol_alpha.Script_typed_ir.ty b ->
  Tezos_raw_protocol_alpha.Script_typed_ir.big_map a b.

Parameter big_map_mem : forall {key value : Set},
  Tezos_raw_protocol_alpha.Alpha_context.context -> key ->
  Tezos_raw_protocol_alpha.Script_typed_ir.big_map key value ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (bool * Tezos_raw_protocol_alpha.Alpha_context.context)).

Parameter big_map_get : forall {key value : Set},
  Tezos_raw_protocol_alpha.Alpha_context.context -> key ->
  Tezos_raw_protocol_alpha.Script_typed_ir.big_map key value ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (option value * Tezos_raw_protocol_alpha.Alpha_context.context)).

Parameter big_map_update : forall {key value : Set},
  key -> option value ->
  Tezos_raw_protocol_alpha.Script_typed_ir.big_map key value ->
  Tezos_raw_protocol_alpha.Script_typed_ir.big_map key value.

Parameter ty_eq : forall {ta tb : Set},
  Tezos_raw_protocol_alpha.Alpha_context.context ->
  Tezos_raw_protocol_alpha.Script_typed_ir.ty ta ->
  Tezos_raw_protocol_alpha.Script_typed_ir.ty tb ->
  Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (eq (Tezos_raw_protocol_alpha.Script_typed_ir.ty ta)
      (Tezos_raw_protocol_alpha.Script_typed_ir.ty tb) *
      Tezos_raw_protocol_alpha.Alpha_context.context).

Parameter compare_comparable : forall {a : Set},
  Tezos_raw_protocol_alpha.Script_typed_ir.comparable_ty a -> a -> a -> Z.

Parameter parse_data : forall {a : Set},
  option type_logger -> Tezos_raw_protocol_alpha.Alpha_context.context ->
  bool -> Tezos_raw_protocol_alpha.Script_typed_ir.ty a ->
  Tezos_raw_protocol_alpha.Alpha_context.Script.node ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (a * Tezos_raw_protocol_alpha.Alpha_context.context)).

Parameter unparse_data : forall {a : Set},
  Tezos_raw_protocol_alpha.Alpha_context.context -> unparsing_mode ->
  Tezos_raw_protocol_alpha.Script_typed_ir.ty a -> a ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Alpha_context.Script.node *
        Tezos_raw_protocol_alpha.Alpha_context.context)).

Parameter parse_instr : forall {bef : Set},
  option type_logger -> tc_context ->
  Tezos_raw_protocol_alpha.Alpha_context.context -> bool ->
  Tezos_raw_protocol_alpha.Alpha_context.Script.node ->
  Tezos_raw_protocol_alpha.Script_typed_ir.stack_ty bef ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (judgement bef * Tezos_raw_protocol_alpha.Alpha_context.context)).

Parameter parse_ty :
  Tezos_raw_protocol_alpha.Alpha_context.context -> bool -> bool -> bool ->
  bool -> Tezos_raw_protocol_alpha.Alpha_context.Script.node ->
  Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (ex_ty * Tezos_raw_protocol_alpha.Alpha_context.context).

Parameter parse_packable_ty :
  Tezos_raw_protocol_alpha.Alpha_context.context -> bool ->
  Tezos_raw_protocol_alpha.Alpha_context.Script.node ->
  Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (ex_ty * Tezos_raw_protocol_alpha.Alpha_context.context).

Parameter unparse_ty : forall {a : Set},
  Tezos_raw_protocol_alpha.Alpha_context.context ->
  Tezos_raw_protocol_alpha.Script_typed_ir.ty a ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Alpha_context.Script.node *
        Tezos_raw_protocol_alpha.Alpha_context.context)).

Parameter parse_toplevel :
  bool -> Tezos_raw_protocol_alpha.Alpha_context.Script.expr ->
  Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (Tezos_raw_protocol_alpha.Alpha_context.Script.node *
      Tezos_raw_protocol_alpha.Alpha_context.Script.node *
      Tezos_raw_protocol_alpha.Alpha_context.Script.node * option string).

Parameter add_field_annot :
  option (* `Field_annot *) string -> option (* `Var_annot *) string ->
  Tezos_raw_protocol_alpha.Alpha_context.Script.node ->
  Tezos_raw_protocol_alpha.Alpha_context.Script.node.

Parameter typecheck_code :
  Tezos_raw_protocol_alpha.Alpha_context.context ->
  Tezos_raw_protocol_alpha.Alpha_context.Script.expr ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Script_tc_errors.type_map *
        Tezos_raw_protocol_alpha.Alpha_context.context)).

Parameter typecheck_data :
  option type_logger -> Tezos_raw_protocol_alpha.Alpha_context.context ->
  Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
    Tezos_raw_protocol_alpha.Alpha_context.Script.expr ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Alpha_context.context).

Parameter parse_script :
  option type_logger -> Tezos_raw_protocol_alpha.Alpha_context.context ->
  bool -> Tezos_raw_protocol_alpha.Alpha_context.Script.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (ex_script * Tezos_raw_protocol_alpha.Alpha_context.context)).

Parameter unparse_script : forall {a b : Set},
  Tezos_raw_protocol_alpha.Alpha_context.context -> unparsing_mode ->
  Tezos_raw_protocol_alpha.Script_typed_ir.script a b ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Alpha_context.Script.t *
        Tezos_raw_protocol_alpha.Alpha_context.context)).

Parameter parse_contract : forall {a : Set},
  bool -> Tezos_raw_protocol_alpha.Alpha_context.context ->
  Tezos_raw_protocol_alpha.Alpha_context.Script.location ->
  Tezos_raw_protocol_alpha.Script_typed_ir.ty a ->
  Tezos_raw_protocol_alpha.Alpha_context.Contract.t -> string ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Alpha_context.context *
        Tezos_raw_protocol_alpha.Script_typed_ir.typed_contract a)).

Parameter parse_contract_for_script : forall {a : Set},
  bool -> Tezos_raw_protocol_alpha.Alpha_context.context ->
  Tezos_raw_protocol_alpha.Alpha_context.Script.location ->
  Tezos_raw_protocol_alpha.Script_typed_ir.ty a ->
  Tezos_raw_protocol_alpha.Alpha_context.Contract.t -> string ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Alpha_context.context *
        option (Tezos_raw_protocol_alpha.Script_typed_ir.typed_contract a))).

Parameter find_entrypoint : forall {t : Set},
  Tezos_raw_protocol_alpha.Script_typed_ir.ty t -> option string -> string ->
  Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    ((Tezos_raw_protocol_alpha.Alpha_context.Script.node ->
    Tezos_raw_protocol_alpha.Alpha_context.Script.node) * ex_ty).

Module Entrypoints_map.
  Definition key := string.
  
  Parameter t : forall (a : Set), Set.
  
  Parameter empty : forall {a : Set}, t a.
  
  Parameter is_empty : forall {a : Set}, t a -> bool.
  
  Parameter mem : forall {a : Set}, key -> t a -> bool.
  
  Parameter add : forall {a : Set}, key -> a -> t a -> t a.
  
  Parameter update : forall {a : Set},
    key -> (option a -> option a) -> t a -> t a.
  
  Parameter singleton : forall {a : Set}, key -> a -> t a.
  
  Parameter remove : forall {a : Set}, key -> t a -> t a.
  
  Parameter merge : forall {a b c : Set},
    (key -> option a -> option b -> option c) -> t a -> t b -> t c.
  
  Parameter union : forall {a : Set},
    (key -> a -> a -> option a) -> t a -> t a -> t a.
  
  Parameter compare : forall {a : Set}, (a -> a -> Z) -> t a -> t a -> Z.
  
  Parameter equal : forall {a : Set}, (a -> a -> bool) -> t a -> t a -> bool.
  
  Parameter iter : forall {a : Set}, (key -> a -> unit) -> t a -> unit.
  
  Parameter fold : forall {a b : Set}, (key -> a -> b -> b) -> t a -> b -> b.
  
  Parameter for_all : forall {a : Set}, (key -> a -> bool) -> t a -> bool.
  
  Parameter __exists : forall {a : Set}, (key -> a -> bool) -> t a -> bool.
  
  Parameter filter : forall {a : Set}, (key -> a -> bool) -> t a -> t a.
  
  Parameter partition : forall {a : Set},
    (key -> a -> bool) -> t a -> t a * t a.
  
  Parameter cardinal : forall {a : Set}, t a -> Z.
  
  Parameter bindings : forall {a : Set}, t a -> list (key * a).
  
  Parameter min_binding_opt : forall {a : Set}, t a -> option (key * a).
  
  Parameter max_binding_opt : forall {a : Set}, t a -> option (key * a).
  
  Parameter choose_opt : forall {a : Set}, t a -> option (key * a).
  
  Parameter split : forall {a : Set}, key -> t a -> t a * option a * t a.
  
  Parameter find_opt : forall {a : Set}, key -> t a -> option a.
  
  Parameter find_first_opt : forall {a : Set},
    (key -> bool) -> t a -> option (key * a).
  
  Parameter find_last_opt : forall {a : Set},
    (key -> bool) -> t a -> option (key * a).
  
  Parameter map : forall {a b : Set}, (a -> b) -> t a -> t b.
  
  Parameter mapi : forall {a b : Set}, (key -> a -> b) -> t a -> t b.
End Entrypoints_map.

Parameter list_entrypoints : forall {t : Set},
  Tezos_raw_protocol_alpha.Script_typed_ir.ty t ->
  Tezos_raw_protocol_alpha.Alpha_context.context -> option string ->
  Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (list (list Tezos_raw_protocol_alpha.Michelson_v1_primitives.prim) *
      Entrypoints_map.t
        (list Tezos_raw_protocol_alpha.Michelson_v1_primitives.prim *
          Tezos_raw_protocol_alpha.Alpha_context.Script.node)).

Parameter pack_data : forall {a : Set},
  Tezos_raw_protocol_alpha.Alpha_context.context ->
  Tezos_raw_protocol_alpha.Script_typed_ir.ty a -> a ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_protocol_environment_alpha__Environment.MBytes.t *
        Tezos_raw_protocol_alpha.Alpha_context.context)).

Parameter hash_data : forall {a : Set},
  Tezos_raw_protocol_alpha.Alpha_context.context ->
  Tezos_raw_protocol_alpha.Script_typed_ir.ty a -> a ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Script_expr_hash.t *
        Tezos_raw_protocol_alpha.Alpha_context.context)).

Parameter big_map_ids : Set.

Parameter no_big_map_id : big_map_ids.

Parameter collect_big_maps : forall {a : Set},
  Tezos_raw_protocol_alpha.Alpha_context.context ->
  Tezos_raw_protocol_alpha.Script_typed_ir.ty a -> a ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (big_map_ids * Tezos_raw_protocol_alpha.Alpha_context.context)).

Parameter list_of_big_map_ids :
  big_map_ids -> list Tezos_protocol_environment_alpha__Environment.Z.t.

Parameter extract_big_map_diff : forall {a : Set},
  Tezos_raw_protocol_alpha.Alpha_context.context -> unparsing_mode -> bool ->
  big_map_ids -> big_map_ids -> Tezos_raw_protocol_alpha.Script_typed_ir.ty a ->
  a ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (a * option Tezos_raw_protocol_alpha.Alpha_context.Contract.big_map_diff *
        Tezos_raw_protocol_alpha.Alpha_context.context)).

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

type location = Micheline.canonical_location

let location_encoding = Micheline.canonical_location_encoding

type annot = Micheline.annot

type expr = Michelson_v1_primitives.prim Micheline.canonical

type lazy_expr = expr Data_encoding.lazy_t

type node = (location, Michelson_v1_primitives.prim) Micheline.node

let expr_encoding =
  Micheline.canonical_encoding_v1
    ~variant:"michelson_v1"
    Michelson_v1_primitives.prim_encoding

type error += Lazy_script_decode (* `Permanent *)

let () =
  register_error_kind
    `Permanent
    ~id:"invalid_binary_format"
    ~title:"Invalid binary format"
    ~description:
      "Could not deserialize some piece of data from its binary representation"
    Data_encoding.empty
    (function Lazy_script_decode -> Some () | _ -> None)
    (fun () -> Lazy_script_decode)

let lazy_expr_encoding = Data_encoding.lazy_encoding expr_encoding

let lazy_expr expr = Data_encoding.make_lazy expr_encoding expr

type t = {code : lazy_expr; storage : lazy_expr}

let encoding =
  let open Data_encoding in
  def "scripted.contracts"
  @@ conv
       (fun {code; storage} -> (code, storage))
       (fun (code, storage) -> {code; storage})
       (obj2 (req "code" lazy_expr_encoding) (req "storage" lazy_expr_encoding))

let int_node_size_of_numbits n = (1, 1 + ((n + 63) / 64))

let int_node_size n = int_node_size_of_numbits (Z.numbits n)

let string_node_size_of_length s = (1, 1 + ((s + 7) / 8))

let string_node_size s = string_node_size_of_length (String.length s)

let bytes_node_size_of_length s =
  (* approx cost of indirection to the C heap *)
  (2, 1 + ((s + 7) / 8) + 12)

let bytes_node_size s = bytes_node_size_of_length (MBytes.length s)

let prim_node_size_nonrec_of_lengths n_args annots =
  let annots_length =
    List.fold_left (fun acc s -> acc + String.length s) 0 annots
  in
  if Compare.Int.(annots_length = 0) then (1 + n_args, 2 + (2 * n_args))
  else (2 + n_args, 4 + (2 * n_args) + ((annots_length + 7) / 8))

let prim_node_size_nonrec args annots =
  let n_args = List.length args in
  prim_node_size_nonrec_of_lengths n_args annots

let seq_node_size_nonrec_of_length n_args = (1 + n_args, 2 + (2 * n_args))

let seq_node_size_nonrec args =
  let n_args = List.length args in
  seq_node_size_nonrec_of_length n_args

let rec node_size node =
  let open Micheline in
  match node with
  | Int (_, n) ->
      int_node_size n
  | String (_, s) ->
      string_node_size s
  | Bytes (_, s) ->
      bytes_node_size s
  | Prim (_, _, args, annot) ->
      List.fold_left
        (fun (blocks, words) node ->
          let (nblocks, nwords) = node_size node in
          (blocks + nblocks, words + nwords))
        (prim_node_size_nonrec args annot)
        args
  | Seq (_, args) ->
      List.fold_left
        (fun (blocks, words) node ->
          let (nblocks, nwords) = node_size node in
          (blocks + nblocks, words + nwords))
        (seq_node_size_nonrec args)
        args

let expr_size expr = node_size (Micheline.root expr)

let traversal_cost node =
  let (blocks, _words) = node_size node in
  Gas_limit_repr.step_cost blocks

let cost_of_size (blocks, words) =
  let open Gas_limit_repr in
  (Compare.Int.max 0 (blocks - 1) *@ alloc_cost 0)
  +@ alloc_cost words +@ step_cost blocks

let node_cost node = cost_of_size (node_size node)

let int_node_cost n = cost_of_size (int_node_size n)

let int_node_cost_of_numbits n = cost_of_size (int_node_size_of_numbits n)

let string_node_cost s = cost_of_size (string_node_size s)

let string_node_cost_of_length s = cost_of_size (string_node_size_of_length s)

let bytes_node_cost s = cost_of_size (bytes_node_size s)

let bytes_node_cost_of_length s = cost_of_size (bytes_node_size_of_length s)

let prim_node_cost_nonrec args annot =
  cost_of_size (prim_node_size_nonrec args annot)

let prim_node_cost_nonrec_of_length n_args annot =
  cost_of_size (prim_node_size_nonrec_of_lengths n_args annot)

let seq_node_cost_nonrec args = cost_of_size (seq_node_size_nonrec args)

let seq_node_cost_nonrec_of_length n_args =
  cost_of_size (seq_node_size_nonrec_of_length n_args)

let deserialized_cost expr = cost_of_size (expr_size expr)

let serialized_cost bytes =
  let open Gas_limit_repr in
  alloc_mbytes_cost (MBytes.length bytes)

let force_decode lexpr =
  let account_deserialization_cost =
    Data_encoding.apply_lazy
      ~fun_value:(fun _ -> false)
      ~fun_bytes:(fun _ -> true)
      ~fun_combine:(fun _ _ -> false)
      lexpr
  in
  match Data_encoding.force_decode lexpr with
  | Some v ->
      if account_deserialization_cost then ok (v, deserialized_cost v)
      else ok (v, Gas_limit_repr.free)
  | None ->
      error Lazy_script_decode

let force_bytes expr =
  let open Gas_limit_repr in
  let account_serialization_cost =
    Data_encoding.apply_lazy
      ~fun_value:(fun v -> Some v)
      ~fun_bytes:(fun _ -> None)
      ~fun_combine:(fun _ _ -> None)
      expr
  in
  match Data_encoding.force_bytes expr with
  | bytes -> (
    match account_serialization_cost with
    | Some v ->
        ok (bytes, traversal_cost (Micheline.root v) +@ serialized_cost bytes)
    | None ->
        ok (bytes, Gas_limit_repr.free) )
  | exception _ ->
      error Lazy_script_decode

let minimal_deserialize_cost lexpr =
  Data_encoding.apply_lazy
    ~fun_value:(fun _ -> Gas_limit_repr.free)
    ~fun_bytes:(fun b -> serialized_cost b)
    ~fun_combine:(fun c_free _ -> c_free)
    lexpr

let unit =
  Micheline.strip_locations (Prim (0, Michelson_v1_primitives.D_Unit, [], []))

let unit_parameter = lazy_expr unit

let is_unit_parameter =
  let unit_bytes = Data_encoding.force_bytes unit_parameter in
  Data_encoding.apply_lazy
    ~fun_value:(fun v ->
      match Micheline.root v with
      | Prim (_, Michelson_v1_primitives.D_Unit, [], []) ->
          true
      | _ ->
          false)
    ~fun_bytes:(fun b -> MBytes.( = ) b unit_bytes)
    ~fun_combine:(fun res _ -> res)

let rec strip_annotations node =
  let open Micheline in
  match node with
  | (Int (_, _) | String (_, _) | Bytes (_, _)) as leaf ->
      leaf
  | Prim (loc, name, args, _) ->
      Prim (loc, name, List.map strip_annotations args, [])
  | Seq (loc, args) ->
      Seq (loc, List.map strip_annotations args)

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Definition location :=
  Tezos_protocol_environment_alpha__Environment.Micheline.canonical_location.

Definition location_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    Tezos_protocol_environment_alpha__Environment.Micheline.canonical_location :=
  Micheline.canonical_location_encoding.

Definition annot :=
  Tezos_protocol_environment_alpha__Environment.Micheline.annot.

Definition expr :=
  Tezos_protocol_environment_alpha__Environment.Micheline.canonical
    Tezos_raw_protocol_alpha.Michelson_v1_primitives.prim.

Definition lazy_expr :=
  Tezos_protocol_environment_alpha__Environment.Data_encoding.lazy_t expr.

Definition node :=
  Tezos_protocol_environment_alpha__Environment.Micheline.node location
    Tezos_raw_protocol_alpha.Michelson_v1_primitives.prim.

Definition expr_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    (Tezos_protocol_environment_alpha__Environment.Micheline.canonical
      Tezos_raw_protocol_alpha.Michelson_v1_primitives.prim) :=
  Micheline.canonical_encoding_v1 "michelson_v1" % string
    Michelson_v1_primitives.prim_encoding.

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Top-level evaluations are considered as an error as sources of side-effects *)
Compute
  register_error_kind
    (* ❌ Variants not supported *)
    variant "invalid_binary_format" % string "Invalid binary format" % string
    "Could not deserialize some piece of data from its binary representation" %
      string None Data_encoding.empty
    (fun function_parameter =>
      match function_parameter with
      |
        Tezos_protocol_environment_alpha__Environment.Error_monad.Lazy_script_decode
        => Some tt
      | _ => None
      end)
    (fun function_parameter =>
      let 'tt := function_parameter in
      Tezos_protocol_environment_alpha__Environment.Error_monad.Lazy_script_decode).

Definition lazy_expr_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    (Tezos_protocol_environment_alpha__Environment.Data_encoding.lazy_t
      (Tezos_protocol_environment_alpha__Environment.Micheline.canonical
        Tezos_raw_protocol_alpha.Michelson_v1_primitives.prim)) :=
  Data_encoding.lazy_encoding expr_encoding.

Definition lazy_expr
  (expr :
    Tezos_protocol_environment_alpha__Environment.Micheline.canonical
      Tezos_raw_protocol_alpha.Michelson_v1_primitives.prim)
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.lazy_t
    (Tezos_protocol_environment_alpha__Environment.Micheline.canonical
      Tezos_raw_protocol_alpha.Michelson_v1_primitives.prim) :=
  Data_encoding.make_lazy expr_encoding expr.

Module t.
  Record record := {
    code : lazy_expr;
    storage : lazy_expr }.
End t.
Definition t := t.record.

Definition encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding t :=
  op_atat
    (let arg := def "scripted.contracts" % string in
    fun eta => arg None None eta)
    (conv
      (fun function_parameter =>
        let '{| t.code := code; t.storage := storage |} := function_parameter in
        (code, storage))
      (fun function_parameter =>
        let '(code, storage) := function_parameter in
        {| t.code := code; t.storage := storage |}) None
      (obj2 (req None None "code" % string lazy_expr_encoding)
        (req None None "storage" % string lazy_expr_encoding))).

Definition int_node_size_of_numbits (n : Z) : Z * Z :=
  (1, (op_plus 1 (op_div (op_plus n 63) 64))).

Definition int_node_size (n : Tezos_protocol_environment_alpha__Environment.Z.t)
  : Z * Z := int_node_size_of_numbits (Z.numbits n).

Definition string_node_size_of_length (s : Z) : Z * Z :=
  (1, (op_plus 1 (op_div (op_plus s 7) 8))).

Definition string_node_size (s : string) : Z * Z :=
  string_node_size_of_length (String.length s).

Definition bytes_node_size_of_length (s : Z) : Z * Z :=
  (2, (op_plus (op_plus 1 (op_div (op_plus s 7) 8)) 12)).

Definition bytes_node_size
  (s : Tezos_protocol_environment_alpha__Environment.MBytes.t) : Z * Z :=
  bytes_node_size_of_length (MBytes.length s).

Definition prim_node_size_nonrec_of_lengths (n_args : Z) (annots : list string)
  : Z * Z :=
  let annots_length :=
    List.fold_left (fun acc => fun s => op_plus acc (String.length s)) 0 annots
    in
  if op_eq annots_length 0 then
    ((op_plus 1 n_args), (op_plus 2 (op_star 2 n_args)))
  else
    ((op_plus 2 n_args),
      (op_plus (op_plus 4 (op_star 2 n_args))
        (op_div (op_plus annots_length 7) 8))).

Definition prim_node_size_nonrec {A : Set}
  (args : list A) (annots : list string) : Z * Z :=
  let n_args := List.length args in
  prim_node_size_nonrec_of_lengths n_args annots.

Definition seq_node_size_nonrec_of_length (n_args : Z) : Z * Z :=
  ((op_plus 1 n_args), (op_plus 2 (op_star 2 n_args))).

Definition seq_node_size_nonrec {A : Set} (args : list A) : Z * Z :=
  let n_args := List.length args in
  seq_node_size_nonrec_of_length n_args.

Fixpoint node_size {A B : Set}
  (node : Tezos_protocol_environment_alpha__Environment.Micheline.node A B)
  : Z * Z :=
  match node with
  | Tezos_protocol_environment_alpha__Environment.Micheline.Int _ n =>
    int_node_size n
  | Tezos_protocol_environment_alpha__Environment.Micheline.String _ s =>
    string_node_size s
  | Tezos_protocol_environment_alpha__Environment.Micheline.Bytes _ s =>
    bytes_node_size s
  | Tezos_protocol_environment_alpha__Environment.Micheline.Prim _ _ args annot
    =>
    List.fold_left
      (fun function_parameter =>
        let '(blocks, words) := function_parameter in
        fun node =>
          let '(nblocks, nwords) := node_size node in
          ((op_plus blocks nblocks), (op_plus words nwords)))
      (prim_node_size_nonrec args annot) args
  | Tezos_protocol_environment_alpha__Environment.Micheline.Seq _ args =>
    List.fold_left
      (fun function_parameter =>
        let '(blocks, words) := function_parameter in
        fun node =>
          let '(nblocks, nwords) := node_size node in
          ((op_plus blocks nblocks), (op_plus words nwords)))
      (seq_node_size_nonrec args) args
  end.

Definition expr_size {A : Set}
  (expr : Tezos_protocol_environment_alpha__Environment.Micheline.canonical A)
  : Z * Z := node_size (Micheline.root expr).

Definition traversal_cost {A B : Set}
  (node : Tezos_protocol_environment_alpha__Environment.Micheline.node A B)
  : Tezos_raw_protocol_alpha.Gas_limit_repr.cost :=
  let '(blocks, _words) := node_size node in
  Gas_limit_repr.step_cost blocks.

Definition cost_of_size (function_parameter : Z * Z)
  : Tezos_raw_protocol_alpha.Gas_limit_repr.cost :=
  let '(blocks, words) := function_parameter in
  op_plusat
    (op_plusat
      (op_starat (Compare.Int.max 0 (op_minus blocks 1)) (alloc_cost 0))
      (alloc_cost words)) (step_cost blocks).

Definition node_cost {A B : Set}
  (node : Tezos_protocol_environment_alpha__Environment.Micheline.node A B)
  : Tezos_raw_protocol_alpha.Gas_limit_repr.cost :=
  cost_of_size (node_size node).

Definition int_node_cost (n : Tezos_protocol_environment_alpha__Environment.Z.t)
  : Tezos_raw_protocol_alpha.Gas_limit_repr.cost :=
  cost_of_size (int_node_size n).

Definition int_node_cost_of_numbits (n : Z)
  : Tezos_raw_protocol_alpha.Gas_limit_repr.cost :=
  cost_of_size (int_node_size_of_numbits n).

Definition string_node_cost (s : string)
  : Tezos_raw_protocol_alpha.Gas_limit_repr.cost :=
  cost_of_size (string_node_size s).

Definition string_node_cost_of_length (s : Z)
  : Tezos_raw_protocol_alpha.Gas_limit_repr.cost :=
  cost_of_size (string_node_size_of_length s).

Definition bytes_node_cost
  (s : Tezos_protocol_environment_alpha__Environment.MBytes.t)
  : Tezos_raw_protocol_alpha.Gas_limit_repr.cost :=
  cost_of_size (bytes_node_size s).

Definition bytes_node_cost_of_length (s : Z)
  : Tezos_raw_protocol_alpha.Gas_limit_repr.cost :=
  cost_of_size (bytes_node_size_of_length s).

Definition prim_node_cost_nonrec {A : Set} (args : list A) (annot : list string)
  : Tezos_raw_protocol_alpha.Gas_limit_repr.cost :=
  cost_of_size (prim_node_size_nonrec args annot).

Definition prim_node_cost_nonrec_of_length (n_args : Z) (annot : list string)
  : Tezos_raw_protocol_alpha.Gas_limit_repr.cost :=
  cost_of_size (prim_node_size_nonrec_of_lengths n_args annot).

Definition seq_node_cost_nonrec {A : Set} (args : list A)
  : Tezos_raw_protocol_alpha.Gas_limit_repr.cost :=
  cost_of_size (seq_node_size_nonrec args).

Definition seq_node_cost_nonrec_of_length (n_args : Z)
  : Tezos_raw_protocol_alpha.Gas_limit_repr.cost :=
  cost_of_size (seq_node_size_nonrec_of_length n_args).

Definition deserialized_cost {A : Set}
  (expr : Tezos_protocol_environment_alpha__Environment.Micheline.canonical A)
  : Tezos_raw_protocol_alpha.Gas_limit_repr.cost :=
  cost_of_size (expr_size expr).

Definition serialized_cost
  (__bytes_value : Tezos_protocol_environment_alpha__Environment.MBytes.t)
  : Tezos_raw_protocol_alpha.Gas_limit_repr.cost :=
  alloc_mbytes_cost (MBytes.length __bytes_value).

Definition force_decode {A : Set}
  (lexpr :
    Tezos_protocol_environment_alpha__Environment.Data_encoding.lazy_t
      (Tezos_protocol_environment_alpha__Environment.Micheline.canonical A))
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (Tezos_protocol_environment_alpha__Environment.Micheline.canonical A *
      Tezos_raw_protocol_alpha.Gas_limit_repr.cost) :=
  let account_deserialization_cost :=
    Data_encoding.apply_lazy
      (fun function_parameter =>
        let '_ := function_parameter in
        false)
      (fun function_parameter =>
        let '_ := function_parameter in
        true)
      (fun function_parameter =>
        let '_ := function_parameter in
        fun function_parameter =>
          let '_ := function_parameter in
          false) lexpr in
  match Data_encoding.force_decode lexpr with
  | Some v =>
    if account_deserialization_cost then
      ok (v, (deserialized_cost v))
    else
      ok (v, Gas_limit_repr.free)
  | None =>
    __error_value
      Tezos_protocol_environment_alpha__Environment.Error_monad.Lazy_script_decode
  end.

Definition force_bytes {A : Set}
  (expr :
    Tezos_protocol_environment_alpha__Environment.Data_encoding.lazy_t
      (Tezos_protocol_environment_alpha__Environment.Micheline.canonical A))
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (Tezos_protocol_environment_alpha__Environment.MBytes.t *
      Tezos_raw_protocol_alpha.Gas_limit_repr.cost) :=
  let account_serialization_cost :=
    Data_encoding.apply_lazy (fun v => Some v)
      (fun function_parameter =>
        let '_ := function_parameter in
        None)
      (fun function_parameter =>
        let '_ := function_parameter in
        fun function_parameter =>
          let '_ := function_parameter in
          None) expr in
  let '__bytes_value := Data_encoding.force_bytes expr in
  match account_serialization_cost with
  | Some v =>
    ok
      (__bytes_value,
        (op_plusat (traversal_cost (Micheline.root v))
          (serialized_cost __bytes_value)))
  | None => ok (__bytes_value, Gas_limit_repr.free)
  end.

Definition minimal_deserialize_cost {A : Set}
  (lexpr : Tezos_protocol_environment_alpha__Environment.Data_encoding.lazy_t A)
  : Tezos_raw_protocol_alpha.Gas_limit_repr.cost :=
  Data_encoding.apply_lazy
    (fun function_parameter =>
      let '_ := function_parameter in
      Gas_limit_repr.free) (fun b => serialized_cost b)
    (fun c_free =>
      fun function_parameter =>
        let '_ := function_parameter in
        c_free) lexpr.

Definition __unit_value
  : Tezos_protocol_environment_alpha__Environment.Micheline.canonical
    Tezos_raw_protocol_alpha.Michelson_v1_primitives.prim :=
  Micheline.strip_locations
    (Tezos_protocol_environment_alpha__Environment.Micheline.Prim 0
      Tezos_raw_protocol_alpha.Michelson_v1_primitives.D_Unit [] []).

Definition unit_parameter
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.lazy_t
    (Tezos_protocol_environment_alpha__Environment.Micheline.canonical
      Tezos_raw_protocol_alpha.Michelson_v1_primitives.prim) :=
  lazy_expr __unit_value.

Definition is_unit_parameter
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.lazy_t
    (Tezos_protocol_environment_alpha__Environment.Micheline.canonical
      Tezos_raw_protocol_alpha.Michelson_v1_primitives.prim) -> bool :=
  let unit_bytes := Data_encoding.force_bytes unit_parameter in
  Data_encoding.apply_lazy
    (fun v =>
      match Micheline.root v with
      |
        Tezos_protocol_environment_alpha__Environment.Micheline.Prim _
          Tezos_raw_protocol_alpha.Michelson_v1_primitives.D_Unit [] [] => true
      | _ => false
      end) (fun b => MBytes.op_eq b unit_bytes)
    (fun res =>
      fun function_parameter =>
        let '_ := function_parameter in
        res).

Fixpoint strip_annotations {A B : Set}
  (node : Tezos_protocol_environment_alpha__Environment.Micheline.node A B)
  : Tezos_protocol_environment_alpha__Environment.Micheline.node A B :=
  match node with
  |
    (Tezos_protocol_environment_alpha__Environment.Micheline.Int _ _ |
      Tezos_protocol_environment_alpha__Environment.Micheline.String _ _ |
      Tezos_protocol_environment_alpha__Environment.Micheline.Bytes _ _) as leaf
    => leaf
  | Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc name args _
    =>
    Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc name
      (List.map strip_annotations args) []
  | Tezos_protocol_environment_alpha__Environment.Micheline.Seq loc args =>
    Tezos_protocol_environment_alpha__Environment.Micheline.Seq loc
      (List.map strip_annotations args)
  end.

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

type location = Micheline.canonical_location

type annot = Micheline.annot

type expr = Michelson_v1_primitives.prim Micheline.canonical

type error += Lazy_script_decode (* `Permanent *)

type lazy_expr = expr Data_encoding.lazy_t

type node = (location, Michelson_v1_primitives.prim) Micheline.node

val location_encoding : location Data_encoding.t

val expr_encoding : expr Data_encoding.t

val lazy_expr_encoding : lazy_expr Data_encoding.t

val lazy_expr : expr -> lazy_expr

type t = {code : lazy_expr; storage : lazy_expr}

val encoding : t Data_encoding.encoding

val deserialized_cost : expr -> Gas_limit_repr.cost

val serialized_cost : MBytes.t -> Gas_limit_repr.cost

val traversal_cost : node -> Gas_limit_repr.cost

val node_cost : node -> Gas_limit_repr.cost

val int_node_cost : Z.t -> Gas_limit_repr.cost

val int_node_cost_of_numbits : int -> Gas_limit_repr.cost

val string_node_cost : string -> Gas_limit_repr.cost

val string_node_cost_of_length : int -> Gas_limit_repr.cost

val bytes_node_cost : MBytes.t -> Gas_limit_repr.cost

val bytes_node_cost_of_length : int -> Gas_limit_repr.cost

val prim_node_cost_nonrec : expr list -> annot -> Gas_limit_repr.cost

val prim_node_cost_nonrec_of_length : int -> annot -> Gas_limit_repr.cost

val seq_node_cost_nonrec : expr list -> Gas_limit_repr.cost

val seq_node_cost_nonrec_of_length : int -> Gas_limit_repr.cost

val force_decode : lazy_expr -> (expr * Gas_limit_repr.cost) tzresult

val force_bytes : lazy_expr -> (MBytes.t * Gas_limit_repr.cost) tzresult

val minimal_deserialize_cost : lazy_expr -> Gas_limit_repr.cost

val unit_parameter : lazy_expr

val is_unit_parameter : lazy_expr -> bool

val strip_annotations : node -> node

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Definition location :=
  Tezos_protocol_environment_alpha__Environment.Micheline.canonical_location.

Definition annot :=
  Tezos_protocol_environment_alpha__Environment.Micheline.annot.

Definition expr :=
  Tezos_protocol_environment_alpha__Environment.Micheline.canonical
    Tezos_raw_protocol_alpha.Michelson_v1_primitives.prim.

(* extensible_type Tezos_protocol_environment_alpha__Environment.Error_monad.error *)

Definition lazy_expr :=
  Tezos_protocol_environment_alpha__Environment.Data_encoding.lazy_t expr.

Definition node :=
  Tezos_protocol_environment_alpha__Environment.Micheline.node location
    Tezos_raw_protocol_alpha.Michelson_v1_primitives.prim.

Parameter location_encoding :
  Tezos_protocol_environment_alpha__Environment.Data_encoding.t location.

Parameter expr_encoding :
  Tezos_protocol_environment_alpha__Environment.Data_encoding.t expr.

Parameter lazy_expr_encoding :
  Tezos_protocol_environment_alpha__Environment.Data_encoding.t lazy_expr.

Parameter lazy_expr : expr -> lazy_expr.

Module t.
  Record record := {
    code : lazy_expr;
    storage : lazy_expr }.
End t.
Definition t := t.record.

Parameter encoding :
  Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding t.

Parameter deserialized_cost :
  expr -> Tezos_raw_protocol_alpha.Gas_limit_repr.cost.

Parameter serialized_cost :
  Tezos_protocol_environment_alpha__Environment.MBytes.t ->
  Tezos_raw_protocol_alpha.Gas_limit_repr.cost.

Parameter traversal_cost : node -> Tezos_raw_protocol_alpha.Gas_limit_repr.cost.

Parameter node_cost : node -> Tezos_raw_protocol_alpha.Gas_limit_repr.cost.

Parameter int_node_cost :
  Tezos_protocol_environment_alpha__Environment.Z.t ->
  Tezos_raw_protocol_alpha.Gas_limit_repr.cost.

Parameter int_node_cost_of_numbits :
  Z -> Tezos_raw_protocol_alpha.Gas_limit_repr.cost.

Parameter string_node_cost :
  string -> Tezos_raw_protocol_alpha.Gas_limit_repr.cost.

Parameter string_node_cost_of_length :
  Z -> Tezos_raw_protocol_alpha.Gas_limit_repr.cost.

Parameter bytes_node_cost :
  Tezos_protocol_environment_alpha__Environment.MBytes.t ->
  Tezos_raw_protocol_alpha.Gas_limit_repr.cost.

Parameter bytes_node_cost_of_length :
  Z -> Tezos_raw_protocol_alpha.Gas_limit_repr.cost.

Parameter prim_node_cost_nonrec :
  list expr -> annot -> Tezos_raw_protocol_alpha.Gas_limit_repr.cost.

Parameter prim_node_cost_nonrec_of_length :
  Z -> annot -> Tezos_raw_protocol_alpha.Gas_limit_repr.cost.

Parameter seq_node_cost_nonrec :
  list expr -> Tezos_raw_protocol_alpha.Gas_limit_repr.cost.

Parameter seq_node_cost_nonrec_of_length :
  Z -> Tezos_raw_protocol_alpha.Gas_limit_repr.cost.

Parameter force_decode :
  lazy_expr ->
  Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (expr * Tezos_raw_protocol_alpha.Gas_limit_repr.cost).

Parameter force_bytes :
  lazy_expr ->
  Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (Tezos_protocol_environment_alpha__Environment.MBytes.t *
      Tezos_raw_protocol_alpha.Gas_limit_repr.cost).

Parameter minimal_deserialize_cost :
  lazy_expr -> Tezos_raw_protocol_alpha.Gas_limit_repr.cost.

Parameter unit_parameter : lazy_expr.

Parameter is_unit_parameter : lazy_expr -> bool.

Parameter strip_annotations : node -> node.

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Alpha_context
open Script

(* ---- Error definitions ---------------------------------------------------*)

(* Auxiliary types for error documentation *)
type namespace =
  | Type_namespace
  | Constant_namespace
  | Instr_namespace
  | Keyword_namespace

type kind = Int_kind | String_kind | Bytes_kind | Prim_kind | Seq_kind

type unparsed_stack_ty = (Script.expr * Script.annot) list

type type_map = (int * (unparsed_stack_ty * unparsed_stack_ty)) list

(* Structure errors *)
type error += Invalid_arity of Script.location * prim * int * int

type error +=
  | Invalid_namespace of Script.location * prim * namespace * namespace

type error += Invalid_primitive of Script.location * prim list * prim

type error += Invalid_kind of Script.location * kind list * kind

type error += Missing_field of prim

type error += Duplicate_field of Script.location * prim

type error += Unexpected_big_map of Script.location

type error += Unexpected_operation of Script.location

type error += Unexpected_contract of Script.location

type error += No_such_entrypoint of string

type error += Duplicate_entrypoint of string

type error += Unreachable_entrypoint of prim list

type error += Entrypoint_name_too_long of string

(* Instruction typing errors *)
type error += Fail_not_in_tail_position of Script.location

type error +=
  | Undefined_binop :
      Script.location * prim * Script.expr * Script.expr
      -> error

type error += Undefined_unop : Script.location * prim * Script.expr -> error

type error +=
  | Bad_return : Script.location * unparsed_stack_ty * Script.expr -> error

type error +=
  | Bad_stack : Script.location * prim * int * unparsed_stack_ty -> error

type error +=
  | Unmatched_branches :
      Script.location * unparsed_stack_ty * unparsed_stack_ty
      -> error

type error += Self_in_lambda of Script.location

type error += Bad_stack_length

type error += Bad_stack_item of int

type error += Inconsistent_annotations of string * string

type error +=
  | Inconsistent_type_annotations :
      Script.location * Script.expr * Script.expr
      -> error

type error += Inconsistent_field_annotations of string * string

type error += Unexpected_annotation of Script.location

type error += Ungrouped_annotations of Script.location

type error += Invalid_map_body : Script.location * unparsed_stack_ty -> error

type error += Invalid_map_block_fail of Script.location

type error +=
  | Invalid_iter_body :
      Script.location * unparsed_stack_ty * unparsed_stack_ty
      -> error

type error += Type_too_large : Script.location * int * int -> error

(* Value typing errors *)
type error +=
  | Invalid_constant : Script.location * Script.expr * Script.expr -> error

type error +=
  | Invalid_syntactic_constant :
      Script.location * Script.expr * string
      -> error

type error += Invalid_contract of Script.location * Contract.t

type error += Invalid_big_map of Script.location * Big_map.id

type error +=
  | Comparable_type_expected : Script.location * Script.expr -> error

type error += Inconsistent_types : Script.expr * Script.expr -> error

type error += Unordered_map_keys of Script.location * Script.expr

type error += Unordered_set_values of Script.location * Script.expr

type error += Duplicate_map_keys of Script.location * Script.expr

type error += Duplicate_set_values of Script.location * Script.expr

(* Toplevel errors *)
type error +=
  | Ill_typed_data : string option * Script.expr * Script.expr -> error

type error +=
  | Ill_formed_type of string option * Script.expr * Script.location

type error += Ill_typed_contract : Script.expr * type_map -> error

(* Gas related errors *)
type error += Cannot_serialize_error

(* Deprecation errors *)
type error += Deprecated_instruction of prim

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Import Alpha_context.

Import Script.

Inductive namespace : Set :=
| Type_namespace : namespace
| Constant_namespace : namespace
| Instr_namespace : namespace
| Keyword_namespace : namespace.

Inductive kind : Set :=
| Int_kind : kind
| String_kind : kind
| Bytes_kind : kind
| Prim_kind : kind
| Seq_kind : kind.

Definition unparsed_stack_ty :=
  list
    (Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
      Tezos_raw_protocol_alpha.Alpha_context.Script.annot).

Definition type_map := list (Z * (unparsed_stack_ty * unparsed_stack_ty)).

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Alpha_context
open Script
open Script_tc_errors

(* Helpers for encoding *)
let type_map_enc =
  let open Data_encoding in
  let stack_enc = list (tup2 Script.expr_encoding (list string)) in
  list
    (conv
       (fun (loc, (bef, aft)) -> (loc, bef, aft))
       (fun (loc, bef, aft) -> (loc, (bef, aft)))
       (obj3
          (req "location" Script.location_encoding)
          (req "stack_before" stack_enc)
          (req "stack_after" stack_enc)))

let stack_ty_enc =
  let open Data_encoding in
  list (obj2 (req "type" Script.expr_encoding) (dft "annots" (list string) []))

(* main registration *)
let () =
  let open Data_encoding in
  let located enc =
    merge_objs (obj1 (req "location" Script.location_encoding)) enc
  in
  let arity_enc = int8 in
  let namespace_enc =
    def
      "primitiveNamespace"
      ~title:"Primitive namespace"
      ~description:
        "One of the three possible namespaces of primitive (data constructor, \
         type name or instruction)."
    @@ string_enum
         [ ("type", Type_namespace);
           ("constant", Constant_namespace);
           ("instruction", Instr_namespace) ]
  in
  let kind_enc =
    def
      "expressionKind"
      ~title:"Expression kind"
      ~description:
        "One of the four possible kinds of expression (integer, string, \
         primitive application or sequence)."
    @@ string_enum
         [ ("integer", Int_kind);
           ("string", String_kind);
           ("bytes", Bytes_kind);
           ("primitiveApplication", Prim_kind);
           ("sequence", Seq_kind) ]
  in
  (* -- Structure errors ---------------------- *)
  (* Invalid arity *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.invalid_arity"
    ~title:"Invalid arity"
    ~description:
      "In a script or data expression, a primitive was applied to an \
       unsupported number of arguments."
    (located
       (obj3
          (req "primitive_name" Script.prim_encoding)
          (req "expected_arity" arity_enc)
          (req "wrong_arity" arity_enc)))
    (function
      | Invalid_arity (loc, name, exp, got) ->
          Some (loc, (name, exp, got))
      | _ ->
          None)
    (fun (loc, (name, exp, got)) -> Invalid_arity (loc, name, exp, got)) ;
  (* Missing field *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.missing_script_field"
    ~title:"Script is missing a field (parse error)"
    ~description:"When parsing script, a field was expected, but not provided"
    (obj1 (req "prim" prim_encoding))
    (function Missing_field prim -> Some prim | _ -> None)
    (fun prim -> Missing_field prim) ;
  (* Invalid primitive *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.invalid_primitive"
    ~title:"Invalid primitive"
    ~description:"In a script or data expression, a primitive was unknown."
    (located
       (obj2
          (dft "expected_primitive_names" (list prim_encoding) [])
          (req "wrong_primitive_name" prim_encoding)))
    (function
      | Invalid_primitive (loc, exp, got) -> Some (loc, (exp, got)) | _ -> None)
    (fun (loc, (exp, got)) -> Invalid_primitive (loc, exp, got)) ;
  (* Invalid kind *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.invalid_expression_kind"
    ~title:"Invalid expression kind"
    ~description:
      "In a script or data expression, an expression was of the wrong kind \
       (for instance a string where only a primitive applications can appear)."
    (located
       (obj2 (req "expected_kinds" (list kind_enc)) (req "wrong_kind" kind_enc)))
    (function
      | Invalid_kind (loc, exp, got) -> Some (loc, (exp, got)) | _ -> None)
    (fun (loc, (exp, got)) -> Invalid_kind (loc, exp, got)) ;
  (* Invalid namespace *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.invalid_primitive_namespace"
    ~title:"Invalid primitive namespace"
    ~description:
      "In a script or data expression, a primitive was of the wrong namespace."
    (located
       (obj3
          (req "primitive_name" prim_encoding)
          (req "expected_namespace" namespace_enc)
          (req "wrong_namespace" namespace_enc)))
    (function
      | Invalid_namespace (loc, name, exp, got) ->
          Some (loc, (name, exp, got))
      | _ ->
          None)
    (fun (loc, (name, exp, got)) -> Invalid_namespace (loc, name, exp, got)) ;
  (* Duplicate field *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.duplicate_script_field"
    ~title:"Script has a duplicated field (parse error)"
    ~description:"When parsing script, a field was found more than once"
    (obj2 (req "loc" location_encoding) (req "prim" prim_encoding))
    (function Duplicate_field (loc, prim) -> Some (loc, prim) | _ -> None)
    (fun (loc, prim) -> Duplicate_field (loc, prim)) ;
  (* Unexpected big_map *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.unexpected_bigmap"
    ~title:"Big map in unauthorized position (type error)"
    ~description:
      "When parsing script, a big_map type was found in a position where it \
       could end up stored inside a big_map, which is forbidden for now."
    (obj1 (req "loc" location_encoding))
    (function Unexpected_big_map loc -> Some loc | _ -> None)
    (fun loc -> Unexpected_big_map loc) ;
  (* Unexpected operation *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.unexpected_operation"
    ~title:"Operation in unauthorized position (type error)"
    ~description:
      "When parsing script, an operation type was found in the storage or \
       parameter field."
    (obj1 (req "loc" location_encoding))
    (function Unexpected_operation loc -> Some loc | _ -> None)
    (fun loc -> Unexpected_operation loc) ;
  (* No such entrypoint *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.no_such_entrypoint"
    ~title:"No such entrypoint (type error)"
    ~description:"An entrypoint was not found when calling a contract."
    (obj1 (req "entrypoint" string))
    (function No_such_entrypoint entrypoint -> Some entrypoint | _ -> None)
    (fun entrypoint -> No_such_entrypoint entrypoint) ;
  (* Unreachable entrypoint *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.unreachable_entrypoint"
    ~title:"Unreachable entrypoint (type error)"
    ~description:"An entrypoint in the contract is not reachable."
    (obj1 (req "path" (list prim_encoding)))
    (function Unreachable_entrypoint path -> Some path | _ -> None)
    (fun path -> Unreachable_entrypoint path) ;
  (* Duplicate entrypoint *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.duplicate_entrypoint"
    ~title:"Duplicate entrypoint (type error)"
    ~description:"Two entrypoints have the same name."
    (obj1 (req "path" string))
    (function Duplicate_entrypoint entrypoint -> Some entrypoint | _ -> None)
    (fun entrypoint -> Duplicate_entrypoint entrypoint) ;
  (* Entrypoint name too long *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.entrypoint_name_too_long"
    ~title:"Entrypoint name too long (type error)"
    ~description:
      "An entrypoint name exceeds the maximum length of 31 characters."
    (obj1 (req "name" string))
    (function
      | Entrypoint_name_too_long entrypoint -> Some entrypoint | _ -> None)
    (fun entrypoint -> Entrypoint_name_too_long entrypoint) ;
  (* Unexpected contract *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.unexpected_contract"
    ~title:"Contract in unauthorized position (type error)"
    ~description:
      "When parsing script, a contract type was found in the storage or \
       parameter field."
    (obj1 (req "loc" location_encoding))
    (function Unexpected_contract loc -> Some loc | _ -> None)
    (fun loc -> Unexpected_contract loc) ;
  (* -- Value typing errors ---------------------- *)
  (* Unordered map keys *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.unordered_map_literal"
    ~title:"Invalid map key order"
    ~description:"Map keys must be in strictly increasing order"
    (obj2
       (req "location" Script.location_encoding)
       (req "item" Script.expr_encoding))
    (function Unordered_map_keys (loc, expr) -> Some (loc, expr) | _ -> None)
    (fun (loc, expr) -> Unordered_map_keys (loc, expr)) ;
  (* Duplicate map keys *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.duplicate_map_keys"
    ~title:"Duplicate map keys"
    ~description:"Map literals cannot contain duplicated keys"
    (obj2
       (req "location" Script.location_encoding)
       (req "item" Script.expr_encoding))
    (function Duplicate_map_keys (loc, expr) -> Some (loc, expr) | _ -> None)
    (fun (loc, expr) -> Duplicate_map_keys (loc, expr)) ;
  (* Unordered set values *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.unordered_set_literal"
    ~title:"Invalid set value order"
    ~description:"Set values must be in strictly increasing order"
    (obj2
       (req "location" Script.location_encoding)
       (req "value" Script.expr_encoding))
    (function
      | Unordered_set_values (loc, expr) -> Some (loc, expr) | _ -> None)
    (fun (loc, expr) -> Unordered_set_values (loc, expr)) ;
  (* Duplicate set values *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.duplicate_set_values_in_literal"
    ~title:"Sets literals cannot contain duplicate elements"
    ~description:
      "Set literals cannot contain duplicate elements, but a duplicae was \
       found while parsing."
    (obj2
       (req "location" Script.location_encoding)
       (req "value" Script.expr_encoding))
    (function
      | Duplicate_set_values (loc, expr) -> Some (loc, expr) | _ -> None)
    (fun (loc, expr) -> Duplicate_set_values (loc, expr)) ;
  (* -- Instruction typing errors ------------- *)
  (* Fail not in tail position *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.fail_not_in_tail_position"
    ~title:"FAIL not in tail position"
    ~description:"There is non trivial garbage code after a FAIL instruction."
    (located empty)
    (function Fail_not_in_tail_position loc -> Some (loc, ()) | _ -> None)
    (fun (loc, ()) -> Fail_not_in_tail_position loc) ;
  (* Undefined binary operation *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.undefined_binop"
    ~title:"Undefined binop"
    ~description:
      "A binary operation is called on operands of types over which it is not \
       defined."
    (located
       (obj3
          (req "operator_name" prim_encoding)
          (req "wrong_left_operand_type" Script.expr_encoding)
          (req "wrong_right_operand_type" Script.expr_encoding)))
    (function
      | Undefined_binop (loc, n, tyl, tyr) ->
          Some (loc, (n, tyl, tyr))
      | _ ->
          None)
    (fun (loc, (n, tyl, tyr)) -> Undefined_binop (loc, n, tyl, tyr)) ;
  (* Undefined unary operation *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.undefined_unop"
    ~title:"Undefined unop"
    ~description:
      "A unary operation is called on an operand of type over which it is not \
       defined."
    (located
       (obj2
          (req "operator_name" prim_encoding)
          (req "wrong_operand_type" Script.expr_encoding)))
    (function Undefined_unop (loc, n, ty) -> Some (loc, (n, ty)) | _ -> None)
    (fun (loc, (n, ty)) -> Undefined_unop (loc, n, ty)) ;
  (* Bad return *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.bad_return"
    ~title:"Bad return"
    ~description:"Unexpected stack at the end of a lambda or script."
    (located
       (obj2
          (req "expected_return_type" Script.expr_encoding)
          (req "wrong_stack_type" stack_ty_enc)))
    (function Bad_return (loc, sty, ty) -> Some (loc, (ty, sty)) | _ -> None)
    (fun (loc, (ty, sty)) -> Bad_return (loc, sty, ty)) ;
  (* Bad stack *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.bad_stack"
    ~title:"Bad stack"
    ~description:"The stack has an unexpected length or contents."
    (located
       (obj3
          (req "primitive_name" prim_encoding)
          (req "relevant_stack_portion" int16)
          (req "wrong_stack_type" stack_ty_enc)))
    (function
      | Bad_stack (loc, name, s, sty) -> Some (loc, (name, s, sty)) | _ -> None)
    (fun (loc, (name, s, sty)) -> Bad_stack (loc, name, s, sty)) ;
  (* Inconsistent annotations *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.inconsistent_annotations"
    ~title:"Annotations inconsistent between branches"
    ~description:"The annotations on two types could not be merged"
    (obj2 (req "annot1" string) (req "annot2" string))
    (function
      | Inconsistent_annotations (annot1, annot2) ->
          Some (annot1, annot2)
      | _ ->
          None)
    (fun (annot1, annot2) -> Inconsistent_annotations (annot1, annot2)) ;
  (* Inconsistent field annotations *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.inconsistent_field_annotations"
    ~title:"Annotations for field accesses is inconsistent"
    ~description:
      "The specified field does not match the field annotation in the type"
    (obj2 (req "annot1" string) (req "annot2" string))
    (function
      | Inconsistent_field_annotations (annot1, annot2) ->
          Some (annot1, annot2)
      | _ ->
          None)
    (fun (annot1, annot2) -> Inconsistent_field_annotations (annot1, annot2)) ;
  (* Inconsistent type annotations *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.inconsistent_type_annotations"
    ~title:"Types contain inconsistent annotations"
    ~description:"The two types contain annotations that do not match"
    (located
       (obj2
          (req "type1" Script.expr_encoding)
          (req "type2" Script.expr_encoding)))
    (function
      | Inconsistent_type_annotations (loc, ty1, ty2) ->
          Some (loc, (ty1, ty2))
      | _ ->
          None)
    (fun (loc, (ty1, ty2)) -> Inconsistent_type_annotations (loc, ty1, ty2)) ;
  (* Unexpected annotation *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.unexpected_annotation"
    ~title:"An annotation was encountered where no annotation is expected"
    ~description:"A node in the syntax tree was impropperly annotated"
    (located empty)
    (function Unexpected_annotation loc -> Some (loc, ()) | _ -> None)
    (fun (loc, ()) -> Unexpected_annotation loc) ;
  (* Ungrouped annotations *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.ungrouped_annotations"
    ~title:"Annotations of the same kind were found spread apart"
    ~description:"Annotations of the same kind must be grouped"
    (located empty)
    (function Ungrouped_annotations loc -> Some (loc, ()) | _ -> None)
    (fun (loc, ()) -> Ungrouped_annotations loc) ;
  (* Unmatched branches *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.unmatched_branches"
    ~title:"Unmatched branches"
    ~description:
      "At the join point at the end of two code branches the stacks have \
       inconsistent lengths or contents."
    (located
       (obj2
          (req "first_stack_type" stack_ty_enc)
          (req "other_stack_type" stack_ty_enc)))
    (function
      | Unmatched_branches (loc, stya, styb) ->
          Some (loc, (stya, styb))
      | _ ->
          None)
    (fun (loc, (stya, styb)) -> Unmatched_branches (loc, stya, styb)) ;
  (* Bad stack item *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.bad_stack_item"
    ~title:"Bad stack item"
    ~description:
      "The type of a stack item is unexpected (this error is always \
       accompanied by a more precise one)."
    (obj1 (req "item_level" int16))
    (function Bad_stack_item n -> Some n | _ -> None)
    (fun n -> Bad_stack_item n) ;
  (* SELF in lambda *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.self_in_lambda"
    ~title:"SELF instruction in lambda"
    ~description:"A SELF instruction was encountered in a lambda expression."
    (located empty)
    (function Self_in_lambda loc -> Some (loc, ()) | _ -> None)
    (fun (loc, ()) -> Self_in_lambda loc) ;
  (* Bad stack length *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.inconsistent_stack_lengths"
    ~title:"Inconsistent stack lengths"
    ~description:
      "A stack was of an unexpected length (this error is always in the \
       context of a located error)."
    empty
    (function Bad_stack_length -> Some () | _ -> None)
    (fun () -> Bad_stack_length) ;
  (* -- Value typing errors ------------------- *)
  (* Invalid constant *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.invalid_constant"
    ~title:"Invalid constant"
    ~description:"A data expression was invalid for its expected type."
    (located
       (obj2
          (req "expected_type" Script.expr_encoding)
          (req "wrong_expression" Script.expr_encoding)))
    (function
      | Invalid_constant (loc, expr, ty) -> Some (loc, (ty, expr)) | _ -> None)
    (fun (loc, (ty, expr)) -> Invalid_constant (loc, expr, ty)) ;
  (* Invalid syntactic constant *)
  register_error_kind
    `Permanent
    ~id:"invalidSyntacticConstantError"
    ~title:"Invalid constant (parse error)"
    ~description:"A compile-time constant was invalid for its expected form."
    (located
       (obj2
          (req "expectedForm" Script.expr_encoding)
          (req "wrongExpression" Script.expr_encoding)))
    (function
      | Invalid_constant (loc, expr, ty) -> Some (loc, (ty, expr)) | _ -> None)
    (fun (loc, (ty, expr)) -> Invalid_constant (loc, expr, ty)) ;
  (* Invalid contract *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.invalid_contract"
    ~title:"Invalid contract"
    ~description:
      "A script or data expression references a contract that does not exist \
       or assumes a wrong type for an existing contract."
    (located (obj1 (req "contract" Contract.encoding)))
    (function Invalid_contract (loc, c) -> Some (loc, c) | _ -> None)
    (fun (loc, c) -> Invalid_contract (loc, c)) ;
  (* Invalid big_map *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.invalid_big_map"
    ~title:"Invalid big_map"
    ~description:
      "A script or data expression references a big_map that does not exist \
       or assumes a wrong type for an existing big_map."
    (located (obj1 (req "big_map" z)))
    (function Invalid_big_map (loc, c) -> Some (loc, c) | _ -> None)
    (fun (loc, c) -> Invalid_big_map (loc, c)) ;
  (* Comparable type expected *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.comparable_type_expected"
    ~title:"Comparable type expected"
    ~description:
      "A non comparable type was used in a place where only comparable types \
       are accepted."
    (located (obj1 (req "wrong_type" Script.expr_encoding)))
    (function
      | Comparable_type_expected (loc, ty) -> Some (loc, ty) | _ -> None)
    (fun (loc, ty) -> Comparable_type_expected (loc, ty)) ;
  (* Inconsistent types *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.inconsistent_types"
    ~title:"Inconsistent types"
    ~description:
      "This is the basic type clash error, that appears in several places \
       where the equality of two types have to be proven, it is always \
       accompanied with another error that provides more context."
    (obj2
       (req "first_type" Script.expr_encoding)
       (req "other_type" Script.expr_encoding))
    (function Inconsistent_types (tya, tyb) -> Some (tya, tyb) | _ -> None)
    (fun (tya, tyb) -> Inconsistent_types (tya, tyb)) ;
  (* -- Instruction typing errors ------------------- *)
  (* Invalid map body *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.invalid_map_body"
    ~title:"Invalid map body"
    ~description:"The body of a map block did not match the expected type"
    (obj2 (req "loc" Script.location_encoding) (req "body_type" stack_ty_enc))
    (function Invalid_map_body (loc, stack) -> Some (loc, stack) | _ -> None)
    (fun (loc, stack) -> Invalid_map_body (loc, stack)) ;
  (* Invalid map block FAIL *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.invalid_map_block_fail"
    ~title:"FAIL instruction occurred as body of map block"
    ~description:
      "FAIL cannot be the only instruction in the body. The propper type of \
       the return list cannot be inferred."
    (obj1 (req "loc" Script.location_encoding))
    (function Invalid_map_block_fail loc -> Some loc | _ -> None)
    (fun loc -> Invalid_map_block_fail loc) ;
  (* Invalid ITER body *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.invalid_iter_body"
    ~title:"ITER body returned wrong stack type"
    ~description:
      "The body of an ITER instruction must result in the same stack type as \
       before the ITER."
    (obj3
       (req "loc" Script.location_encoding)
       (req "bef_stack" stack_ty_enc)
       (req "aft_stack" stack_ty_enc))
    (function
      | Invalid_iter_body (loc, bef, aft) -> Some (loc, bef, aft) | _ -> None)
    (fun (loc, bef, aft) -> Invalid_iter_body (loc, bef, aft)) ;
  (* Type too large *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.type_too_large"
    ~title:"Stack item type too large"
    ~description:"An instruction generated a type larger than the limit."
    (obj3
       (req "loc" Script.location_encoding)
       (req "type_size" uint16)
       (req "maximum_type_size" uint16))
    (function
      | Type_too_large (loc, ts, maxts) -> Some (loc, ts, maxts) | _ -> None)
    (fun (loc, ts, maxts) -> Type_too_large (loc, ts, maxts)) ;
  (* -- Toplevel errors ------------------- *)
  (* Ill typed data *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.ill_typed_data"
    ~title:"Ill typed data"
    ~description:
      "The toplevel error thrown when trying to typecheck a data expression \
       against a given type (always followed by more precise errors)."
    (obj3
       (opt "identifier" string)
       (req "expected_type" Script.expr_encoding)
       (req "ill_typed_expression" Script.expr_encoding))
    (function
      | Ill_typed_data (name, expr, ty) -> Some (name, ty, expr) | _ -> None)
    (fun (name, ty, expr) -> Ill_typed_data (name, expr, ty)) ;
  (* Ill formed type *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.ill_formed_type"
    ~title:"Ill formed type"
    ~description:
      "The toplevel error thrown when trying to parse a type expression \
       (always followed by more precise errors)."
    (obj3
       (opt "identifier" string)
       (req "ill_formed_expression" Script.expr_encoding)
       (req "location" Script.location_encoding))
    (function
      | Ill_formed_type (name, expr, loc) -> Some (name, expr, loc) | _ -> None)
    (fun (name, expr, loc) -> Ill_formed_type (name, expr, loc)) ;
  (* Ill typed contract *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.ill_typed_contract"
    ~title:"Ill typed contract"
    ~description:
      "The toplevel error thrown when trying to typecheck a contract code \
       against given input, output and storage types (always followed by more \
       precise errors)."
    (obj2
       (req "ill_typed_code" Script.expr_encoding)
       (req "type_map" type_map_enc))
    (function
      | Ill_typed_contract (expr, type_map) ->
          Some (expr, type_map)
      | _ ->
          None)
    (fun (expr, type_map) -> Ill_typed_contract (expr, type_map)) ;
  (* Cannot serialize error *)
  register_error_kind
    `Temporary
    ~id:"michelson_v1.cannot_serialize_error"
    ~title:"Not enough gas to serialize error"
    ~description:"The error was too big to be serialized with the provided gas"
    Data_encoding.empty
    (function Cannot_serialize_error -> Some () | _ -> None)
    (fun () -> Cannot_serialize_error) ;
  (* Deprecated instruction *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.deprecated_instruction"
    ~title:"Script is using a deprecated instruction"
    ~description:
      "A deprecated instruction usage is disallowed in newly created contracts"
    (obj1 (req "prim" prim_encoding))
    (function Deprecated_instruction prim -> Some prim | _ -> None)
    (fun prim -> Deprecated_instruction prim)

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Import Alpha_context.

Import Script.

Import Script_tc_errors.

Definition type_map_enc
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    (list
      (Tezos_raw_protocol_alpha.Alpha_context.Script.location *
        (list (Tezos_raw_protocol_alpha.Alpha_context.Script.expr * list string)
          *
          list
            (Tezos_raw_protocol_alpha.Alpha_context.Script.expr * list string)))) :=
  let stack_enc :=
    __list_value None
      (tup2 Script.expr_encoding (__list_value None __string_value)) in
  __list_value None
    (conv
      (fun function_parameter =>
        let '(loc, (bef, aft)) := function_parameter in
        (loc, bef, aft))
      (fun function_parameter =>
        let '(loc, bef, aft) := function_parameter in
        (loc, (bef, aft))) None
      (obj3 (req None None "location" % string Script.location_encoding)
        (req None None "stack_before" % string stack_enc)
        (req None None "stack_after" % string stack_enc))).

Definition stack_ty_enc
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    (list (Tezos_raw_protocol_alpha.Alpha_context.Script.expr * list string)) :=
  __list_value None
    (obj2 (req None None "type" % string Script.expr_encoding)
      (dft None None "annots" % string (__list_value None __string_value) [])).

(* ❌ Top-level evaluations are considered as an error as sources of side-effects *)
Compute
  let located {A : Set}
    (enc :
    Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding A)
    : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
      (Tezos_raw_protocol_alpha.Alpha_context.Script.location * A) :=
    merge_objs
      (obj1 (req None None "location" % string Script.location_encoding)) enc in
  let arity_enc := int8 in
  let namespace_enc :=
    op_atat
      (def "primitiveNamespace" % string (Some "Primitive namespace" % string)
        (Some
          "One of the three possible namespaces of primitive (data constructor, type name or instruction)."
            % string))
      (string_enum
        (cons
          ("type" % string,
            Tezos_raw_protocol_alpha.Script_tc_errors.Type_namespace)
          (cons
            ("constant" % string,
              Tezos_raw_protocol_alpha.Script_tc_errors.Constant_namespace)
            (cons
              ("instruction" % string,
                Tezos_raw_protocol_alpha.Script_tc_errors.Instr_namespace) []))))
    in
  let kind_enc :=
    op_atat
      (def "expressionKind" % string (Some "Expression kind" % string)
        (Some
          "One of the four possible kinds of expression (integer, string, primitive application or sequence)."
            % string))
      (string_enum
        (cons
          ("integer" % string,
            Tezos_raw_protocol_alpha.Script_tc_errors.Int_kind)
          (cons
            ("string" % string,
              Tezos_raw_protocol_alpha.Script_tc_errors.String_kind)
            (cons
              ("bytes" % string,
                Tezos_raw_protocol_alpha.Script_tc_errors.Bytes_kind)
              (cons
                ("primitiveApplication" % string,
                  Tezos_raw_protocol_alpha.Script_tc_errors.Prim_kind)
                (cons
                  ("sequence" % string,
                    Tezos_raw_protocol_alpha.Script_tc_errors.Seq_kind) []))))))
    in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.invalid_arity" % string "Invalid arity" % string
      "In a script or data expression, a primitive was applied to an unsupported number of arguments."
        % string None
      (located
        (obj3 (req None None "primitive_name" % string Script.prim_encoding)
          (req None None "expected_arity" % string arity_enc)
          (req None None "wrong_arity" % string arity_enc)))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_arity
            loc name exp got => Some (loc, (name, exp, got))
        | _ => None
        end)
      (fun function_parameter =>
        let '(loc, (name, exp, got)) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_arity
          loc name exp got) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.missing_script_field" % string
      "Script is missing a field (parse error)" % string
      "When parsing script, a field was expected, but not provided" % string
      None (obj1 (req None None "prim" % string prim_encoding))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Missing_field
            prim => Some prim
        | _ => None
        end)
      (fun prim =>
        Tezos_protocol_environment_alpha__Environment.Error_monad.Missing_field
          prim) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.invalid_primitive" % string
      "Invalid primitive" % string
      "In a script or data expression, a primitive was unknown." % string None
      (located
        (obj2
          (dft None None "expected_primitive_names" % string
            (__list_value None prim_encoding) [])
          (req None None "wrong_primitive_name" % string prim_encoding)))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_primitive
            loc exp got => Some (loc, (exp, got))
        | _ => None
        end)
      (fun function_parameter =>
        let '(loc, (exp, got)) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_primitive
          loc exp got) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.invalid_expression_kind" % string
      "Invalid expression kind" % string
      "In a script or data expression, an expression was of the wrong kind (for instance a string where only a primitive applications can appear)."
        % string None
      (located
        (obj2
          (req None None "expected_kinds" % string (__list_value None kind_enc))
          (req None None "wrong_kind" % string kind_enc)))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_kind
            loc exp got => Some (loc, (exp, got))
        | _ => None
        end)
      (fun function_parameter =>
        let '(loc, (exp, got)) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_kind
          loc exp got) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.invalid_primitive_namespace" % string
      "Invalid primitive namespace" % string
      "In a script or data expression, a primitive was of the wrong namespace."
        % string None
      (located
        (obj3 (req None None "primitive_name" % string prim_encoding)
          (req None None "expected_namespace" % string namespace_enc)
          (req None None "wrong_namespace" % string namespace_enc)))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_namespace
            loc name exp got => Some (loc, (name, exp, got))
        | _ => None
        end)
      (fun function_parameter =>
        let '(loc, (name, exp, got)) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_namespace
          loc name exp got) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.duplicate_script_field" % string
      "Script has a duplicated field (parse error)" % string
      "When parsing script, a field was found more than once" % string None
      (obj2 (req None None "loc" % string location_encoding)
        (req None None "prim" % string prim_encoding))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Duplicate_field
            loc prim => Some (loc, prim)
        | _ => None
        end)
      (fun function_parameter =>
        let '(loc, prim) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Duplicate_field
          loc prim) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.unexpected_bigmap" % string
      "Big map in unauthorized position (type error)" % string
      "When parsing script, a big_map type was found in a position where it could end up stored inside a big_map, which is forbidden for now."
        % string None (obj1 (req None None "loc" % string location_encoding))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_big_map
            loc => Some loc
        | _ => None
        end)
      (fun loc =>
        Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_big_map
          loc) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.unexpected_operation" % string
      "Operation in unauthorized position (type error)" % string
      "When parsing script, an operation type was found in the storage or parameter field."
        % string None (obj1 (req None None "loc" % string location_encoding))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_operation
            loc => Some loc
        | _ => None
        end)
      (fun loc =>
        Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_operation
          loc) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.no_such_entrypoint" % string
      "No such entrypoint (type error)" % string
      "An entrypoint was not found when calling a contract." % string None
      (obj1 (req None None "entrypoint" % string __string_value))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.No_such_entrypoint
            entrypoint => Some entrypoint
        | _ => None
        end)
      (fun entrypoint =>
        Tezos_protocol_environment_alpha__Environment.Error_monad.No_such_entrypoint
          entrypoint) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.unreachable_entrypoint" % string
      "Unreachable entrypoint (type error)" % string
      "An entrypoint in the contract is not reachable." % string None
      (obj1 (req None None "path" % string (__list_value None prim_encoding)))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Unreachable_entrypoint
            path => Some path
        | _ => None
        end)
      (fun path =>
        Tezos_protocol_environment_alpha__Environment.Error_monad.Unreachable_entrypoint
          path) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.duplicate_entrypoint" % string
      "Duplicate entrypoint (type error)" % string
      "Two entrypoints have the same name." % string None
      (obj1 (req None None "path" % string __string_value))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Duplicate_entrypoint
            entrypoint => Some entrypoint
        | _ => None
        end)
      (fun entrypoint =>
        Tezos_protocol_environment_alpha__Environment.Error_monad.Duplicate_entrypoint
          entrypoint) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.entrypoint_name_too_long" % string
      "Entrypoint name too long (type error)" % string
      "An entrypoint name exceeds the maximum length of 31 characters." % string
      None (obj1 (req None None "name" % string __string_value))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Entrypoint_name_too_long
            entrypoint => Some entrypoint
        | _ => None
        end)
      (fun entrypoint =>
        Tezos_protocol_environment_alpha__Environment.Error_monad.Entrypoint_name_too_long
          entrypoint) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.unexpected_contract" % string
      "Contract in unauthorized position (type error)" % string
      "When parsing script, a contract type was found in the storage or parameter field."
        % string None (obj1 (req None None "loc" % string location_encoding))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_contract
            loc => Some loc
        | _ => None
        end)
      (fun loc =>
        Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_contract
          loc) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.unordered_map_literal" % string
      "Invalid map key order" % string
      "Map keys must be in strictly increasing order" % string None
      (obj2 (req None None "location" % string Script.location_encoding)
        (req None None "item" % string Script.expr_encoding))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Unordered_map_keys
            loc expr => Some (loc, expr)
        | _ => None
        end)
      (fun function_parameter =>
        let '(loc, expr) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Unordered_map_keys
          loc expr) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.duplicate_map_keys" % string
      "Duplicate map keys" % string
      "Map literals cannot contain duplicated keys" % string None
      (obj2 (req None None "location" % string Script.location_encoding)
        (req None None "item" % string Script.expr_encoding))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Duplicate_map_keys
            loc expr => Some (loc, expr)
        | _ => None
        end)
      (fun function_parameter =>
        let '(loc, expr) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Duplicate_map_keys
          loc expr) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.unordered_set_literal" % string
      "Invalid set value order" % string
      "Set values must be in strictly increasing order" % string None
      (obj2 (req None None "location" % string Script.location_encoding)
        (req None None "value" % string Script.expr_encoding))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Unordered_set_values
            loc expr => Some (loc, expr)
        | _ => None
        end)
      (fun function_parameter =>
        let '(loc, expr) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Unordered_set_values
          loc expr) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.duplicate_set_values_in_literal" % string
      "Sets literals cannot contain duplicate elements" % string
      "Set literals cannot contain duplicate elements, but a duplicae was found while parsing."
        % string None
      (obj2 (req None None "location" % string Script.location_encoding)
        (req None None "value" % string Script.expr_encoding))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Duplicate_set_values
            loc expr => Some (loc, expr)
        | _ => None
        end)
      (fun function_parameter =>
        let '(loc, expr) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Duplicate_set_values
          loc expr) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.fail_not_in_tail_position" % string
      "FAIL not in tail position" % string
      "There is non trivial garbage code after a FAIL instruction." % string
      None (located empty)
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Fail_not_in_tail_position
            loc => Some (loc, tt)
        | _ => None
        end)
      (fun function_parameter =>
        let '(loc, tt) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Fail_not_in_tail_position
          loc) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.undefined_binop" % string "Undefined binop" % string
      "A binary operation is called on operands of types over which it is not defined."
        % string None
      (located
        (obj3 (req None None "operator_name" % string prim_encoding)
          (req None None "wrong_left_operand_type" % string Script.expr_encoding)
          (req None None "wrong_right_operand_type" % string
            Script.expr_encoding)))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Undefined_binop
            loc n tyl tyr => Some (loc, (n, tyl, tyr))
        | _ => None
        end)
      (fun function_parameter =>
        let '(loc, (n, tyl, tyr)) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Undefined_binop
          loc n tyl tyr) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.undefined_unop" % string "Undefined unop" % string
      "A unary operation is called on an operand of type over which it is not defined."
        % string None
      (located
        (obj2 (req None None "operator_name" % string prim_encoding)
          (req None None "wrong_operand_type" % string Script.expr_encoding)))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Undefined_unop
            loc n ty => Some (loc, (n, ty))
        | _ => None
        end)
      (fun function_parameter =>
        let '(loc, (n, ty)) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Undefined_unop
          loc n ty) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.bad_return" % string "Bad return" % string
      "Unexpected stack at the end of a lambda or script." % string None
      (located
        (obj2
          (req None None "expected_return_type" % string Script.expr_encoding)
          (req None None "wrong_stack_type" % string stack_ty_enc)))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Bad_return
            loc sty ty => Some (loc, (ty, sty))
        | _ => None
        end)
      (fun function_parameter =>
        let '(loc, (ty, sty)) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Bad_return loc
          sty ty) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.bad_stack" % string "Bad stack" % string
      "The stack has an unexpected length or contents." % string None
      (located
        (obj3 (req None None "primitive_name" % string prim_encoding)
          (req None None "relevant_stack_portion" % string int16)
          (req None None "wrong_stack_type" % string stack_ty_enc)))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Bad_stack
            loc name s sty => Some (loc, (name, s, sty))
        | _ => None
        end)
      (fun function_parameter =>
        let '(loc, (name, s, sty)) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Bad_stack loc
          name s sty) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.inconsistent_annotations" % string
      "Annotations inconsistent between branches" % string
      "The annotations on two types could not be merged" % string None
      (obj2 (req None None "annot1" % string __string_value)
        (req None None "annot2" % string __string_value))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Inconsistent_annotations
            annot1 annot2 => Some (annot1, annot2)
        | _ => None
        end)
      (fun function_parameter =>
        let '(annot1, annot2) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Inconsistent_annotations
          annot1 annot2) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.inconsistent_field_annotations" % string
      "Annotations for field accesses is inconsistent" % string
      "The specified field does not match the field annotation in the type" %
        string None
      (obj2 (req None None "annot1" % string __string_value)
        (req None None "annot2" % string __string_value))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Inconsistent_field_annotations
            annot1 annot2 => Some (annot1, annot2)
        | _ => None
        end)
      (fun function_parameter =>
        let '(annot1, annot2) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Inconsistent_field_annotations
          annot1 annot2) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.inconsistent_type_annotations" % string
      "Types contain inconsistent annotations" % string
      "The two types contain annotations that do not match" % string None
      (located
        (obj2 (req None None "type1" % string Script.expr_encoding)
          (req None None "type2" % string Script.expr_encoding)))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Inconsistent_type_annotations
            loc ty1 ty2 => Some (loc, (ty1, ty2))
        | _ => None
        end)
      (fun function_parameter =>
        let '(loc, (ty1, ty2)) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Inconsistent_type_annotations
          loc ty1 ty2) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.unexpected_annotation" % string
      "An annotation was encountered where no annotation is expected" % string
      "A node in the syntax tree was impropperly annotated" % string None
      (located empty)
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_annotation
            loc => Some (loc, tt)
        | _ => None
        end)
      (fun function_parameter =>
        let '(loc, tt) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_annotation
          loc) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.ungrouped_annotations" % string
      "Annotations of the same kind were found spread apart" % string
      "Annotations of the same kind must be grouped" % string None
      (located empty)
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Ungrouped_annotations
            loc => Some (loc, tt)
        | _ => None
        end)
      (fun function_parameter =>
        let '(loc, tt) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Ungrouped_annotations
          loc) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.unmatched_branches" % string
      "Unmatched branches" % string
      "At the join point at the end of two code branches the stacks have inconsistent lengths or contents."
        % string None
      (located
        (obj2 (req None None "first_stack_type" % string stack_ty_enc)
          (req None None "other_stack_type" % string stack_ty_enc)))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Unmatched_branches
            loc stya styb => Some (loc, (stya, styb))
        | _ => None
        end)
      (fun function_parameter =>
        let '(loc, (stya, styb)) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Unmatched_branches
          loc stya styb) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.bad_stack_item" % string "Bad stack item" % string
      "The type of a stack item is unexpected (this error is always accompanied by a more precise one)."
        % string None (obj1 (req None None "item_level" % string int16))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Bad_stack_item
            n => Some n
        | _ => None
        end)
      (fun n =>
        Tezos_protocol_environment_alpha__Environment.Error_monad.Bad_stack_item
          n) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.self_in_lambda" % string
      "SELF instruction in lambda" % string
      "A SELF instruction was encountered in a lambda expression." % string None
      (located empty)
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Self_in_lambda
            loc => Some (loc, tt)
        | _ => None
        end)
      (fun function_parameter =>
        let '(loc, tt) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Self_in_lambda
          loc) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.inconsistent_stack_lengths" % string
      "Inconsistent stack lengths" % string
      "A stack was of an unexpected length (this error is always in the context of a located error)."
        % string None empty
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Bad_stack_length
          => Some tt
        | _ => None
        end)
      (fun function_parameter =>
        let 'tt := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Bad_stack_length)
    in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.invalid_constant" % string
      "Invalid constant" % string
      "A data expression was invalid for its expected type." % string None
      (located
        (obj2 (req None None "expected_type" % string Script.expr_encoding)
          (req None None "wrong_expression" % string Script.expr_encoding)))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_constant
            loc expr ty => Some (loc, (ty, expr))
        | _ => None
        end)
      (fun function_parameter =>
        let '(loc, (ty, expr)) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_constant
          loc expr ty) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "invalidSyntacticConstantError" % string
      "Invalid constant (parse error)" % string
      "A compile-time constant was invalid for its expected form." % string None
      (located
        (obj2 (req None None "expectedForm" % string Script.expr_encoding)
          (req None None "wrongExpression" % string Script.expr_encoding)))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_constant
            loc expr ty => Some (loc, (ty, expr))
        | _ => None
        end)
      (fun function_parameter =>
        let '(loc, (ty, expr)) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_constant
          loc expr ty) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.invalid_contract" % string
      "Invalid contract" % string
      "A script or data expression references a contract that does not exist or assumes a wrong type for an existing contract."
        % string None
      (located (obj1 (req None None "contract" % string Contract.encoding)))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_contract
            loc c => Some (loc, c)
        | _ => None
        end)
      (fun function_parameter =>
        let '(loc, c) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_contract
          loc c) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.invalid_big_map" % string "Invalid big_map" % string
      "A script or data expression references a big_map that does not exist or assumes a wrong type for an existing big_map."
        % string None (located (obj1 (req None None "big_map" % string z)))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_big_map
            loc c => Some (loc, c)
        | _ => None
        end)
      (fun function_parameter =>
        let '(loc, c) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_big_map
          loc c) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.comparable_type_expected" % string
      "Comparable type expected" % string
      "A non comparable type was used in a place where only comparable types are accepted."
        % string None
      (located (obj1 (req None None "wrong_type" % string Script.expr_encoding)))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Comparable_type_expected
            loc ty => Some (loc, ty)
        | _ => None
        end)
      (fun function_parameter =>
        let '(loc, ty) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Comparable_type_expected
          loc ty) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.inconsistent_types" % string
      "Inconsistent types" % string
      "This is the basic type clash error, that appears in several places where the equality of two types have to be proven, it is always accompanied with another error that provides more context."
        % string None
      (obj2 (req None None "first_type" % string Script.expr_encoding)
        (req None None "other_type" % string Script.expr_encoding))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Inconsistent_types
            tya tyb => Some (tya, tyb)
        | _ => None
        end)
      (fun function_parameter =>
        let '(tya, tyb) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Inconsistent_types
          tya tyb) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.invalid_map_body" % string
      "Invalid map body" % string
      "The body of a map block did not match the expected type" % string None
      (obj2 (req None None "loc" % string Script.location_encoding)
        (req None None "body_type" % string stack_ty_enc))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_map_body
            loc stack => Some (loc, stack)
        | _ => None
        end)
      (fun function_parameter =>
        let '(loc, stack) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_map_body
          loc stack) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.invalid_map_block_fail" % string
      "FAIL instruction occurred as body of map block" % string
      "FAIL cannot be the only instruction in the body. The propper type of the return list cannot be inferred."
        % string None
      (obj1 (req None None "loc" % string Script.location_encoding))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_map_block_fail
            loc => Some loc
        | _ => None
        end)
      (fun loc =>
        Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_map_block_fail
          loc) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.invalid_iter_body" % string
      "ITER body returned wrong stack type" % string
      "The body of an ITER instruction must result in the same stack type as before the ITER."
        % string None
      (obj3 (req None None "loc" % string Script.location_encoding)
        (req None None "bef_stack" % string stack_ty_enc)
        (req None None "aft_stack" % string stack_ty_enc))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_iter_body
            loc bef aft => Some (loc, bef, aft)
        | _ => None
        end)
      (fun function_parameter =>
        let '(loc, bef, aft) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_iter_body
          loc bef aft) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.type_too_large" % string
      "Stack item type too large" % string
      "An instruction generated a type larger than the limit." % string None
      (obj3 (req None None "loc" % string Script.location_encoding)
        (req None None "type_size" % string uint16)
        (req None None "maximum_type_size" % string uint16))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Type_too_large
            loc ts maxts => Some (loc, ts, maxts)
        | _ => None
        end)
      (fun function_parameter =>
        let '(loc, ts, maxts) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Type_too_large
          loc ts maxts) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.ill_typed_data" % string "Ill typed data" % string
      "The toplevel error thrown when trying to typecheck a data expression against a given type (always followed by more precise errors)."
        % string None
      (obj3 (opt None None "identifier" % string __string_value)
        (req None None "expected_type" % string Script.expr_encoding)
        (req None None "ill_typed_expression" % string Script.expr_encoding))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Ill_typed_data
            name expr ty => Some (name, ty, expr)
        | _ => None
        end)
      (fun function_parameter =>
        let '(name, ty, expr) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Ill_typed_data
          name expr ty) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.ill_formed_type" % string "Ill formed type" % string
      "The toplevel error thrown when trying to parse a type expression (always followed by more precise errors)."
        % string None
      (obj3 (opt None None "identifier" % string __string_value)
        (req None None "ill_formed_expression" % string Script.expr_encoding)
        (req None None "location" % string Script.location_encoding))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Ill_formed_type
            name expr loc => Some (name, expr, loc)
        | _ => None
        end)
      (fun function_parameter =>
        let '(name, expr, loc) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Ill_formed_type
          name expr loc) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.ill_typed_contract" % string
      "Ill typed contract" % string
      "The toplevel error thrown when trying to typecheck a contract code against given input, output and storage types (always followed by more precise errors)."
        % string None
      (obj2 (req None None "ill_typed_code" % string Script.expr_encoding)
        (req None None "type_map" % string type_map_enc))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Ill_typed_contract
            expr type_map => Some (expr, type_map)
        | _ => None
        end)
      (fun function_parameter =>
        let '(expr, type_map) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Ill_typed_contract
          expr type_map) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.cannot_serialize_error" % string
      "Not enough gas to serialize error" % string
      "The error was too big to be serialized with the provided gas" % string
      None Data_encoding.empty
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Cannot_serialize_error
          => Some tt
        | _ => None
        end)
      (fun function_parameter =>
        let 'tt := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Cannot_serialize_error)
    in
  register_error_kind
    (* ❌ Variants not supported *)
    variant "michelson_v1.deprecated_instruction" % string
    "Script is using a deprecated instruction" % string
    "A deprecated instruction usage is disallowed in newly created contracts" %
      string None (obj1 (req None None "prim" % string prim_encoding))
    (fun function_parameter =>
      match function_parameter with
      |
        Tezos_protocol_environment_alpha__Environment.Error_monad.Deprecated_instruction
          prim => Some prim
      | _ => None
      end)
    (fun prim =>
      Tezos_protocol_environment_alpha__Environment.Error_monad.Deprecated_instruction
        prim).

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

type t = Z.t

let compare = Z.compare

let of_int64 = Z.of_int64

let of_string x =
  match Time_repr.of_notation x with
  | None -> (
    try Some (Z.of_string x) with _ -> None )
  | Some time ->
      Some (of_int64 (Time_repr.to_seconds time))

let to_notation x =
  try
    let notation = Time_repr.to_notation (Time.of_seconds (Z.to_int64 x)) in
    if String.equal notation "out_of_range" then None else Some notation
  with _ -> None

let to_num_str = Z.to_string

let to_string x = match to_notation x with None -> to_num_str x | Some s -> s

let diff x y = Script_int_repr.of_zint @@ Z.sub x y

let sub_delta t delta = Z.sub t (Script_int_repr.to_zint delta)

let add_delta t delta = Z.add t (Script_int_repr.to_zint delta)

let to_zint x = x

let of_zint x = x

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Definition t := Tezos_protocol_environment_alpha__Environment.Z.t.

Definition compare
  : Tezos_protocol_environment_alpha__Environment.Z.t ->
  Tezos_protocol_environment_alpha__Environment.Z.t -> Z := Z.compare.

Definition of_int64
  : int64 -> Tezos_protocol_environment_alpha__Environment.Z.t := Z.of_int64.

Definition of_string (x : string)
  : option Tezos_protocol_environment_alpha__Environment.Z.t :=
  match Time_repr.of_notation x with
  | None =>
    (* ❌ Try-with are not handled *)
    try (Some (Z.of_string x))
  | Some time => Some (of_int64 (Time_repr.to_seconds time))
  end.

Definition to_notation (x : Tezos_protocol_environment_alpha__Environment.Z.t)
  : option string :=
  (* ❌ Try-with are not handled *)
  try
    (let notation := Time_repr.to_notation (Time.of_seconds (Z.to_int64 x)) in
    if String.equal notation "out_of_range" % string then
      None
    else
      Some notation).

Definition to_num_str
  : Tezos_protocol_environment_alpha__Environment.Z.t -> string := Z.to_string.

Definition to_string (x : Tezos_protocol_environment_alpha__Environment.Z.t)
  : string :=
  match to_notation x with
  | None => to_num_str x
  | Some s => s
  end.

Definition diff
  (x : Tezos_protocol_environment_alpha__Environment.Z.t)
  (y : Tezos_protocol_environment_alpha__Environment.Z.t)
  : Tezos_raw_protocol_alpha.Script_int_repr.num
    Tezos_raw_protocol_alpha.Script_int_repr.z :=
  op_atat Script_int_repr.of_zint (Z.sub x y).

Definition sub_delta {A : Set}
  (t : Tezos_protocol_environment_alpha__Environment.Z.t)
  (delta : Tezos_raw_protocol_alpha.Script_int_repr.num A)
  : Tezos_protocol_environment_alpha__Environment.Z.t :=
  Z.sub t (Script_int_repr.to_zint delta).

Definition add_delta {A : Set}
  (t : Tezos_protocol_environment_alpha__Environment.Z.t)
  (delta : Tezos_raw_protocol_alpha.Script_int_repr.num A)
  : Tezos_protocol_environment_alpha__Environment.Z.t :=
  Z.add t (Script_int_repr.to_zint delta).

Definition to_zint {A : Set} (x : A) : A := x.

Definition of_zint {A : Set} (x : A) : A := x.

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Script_int_repr

type t

val of_int64 : int64 -> t

val compare : t -> t -> int

(* Convert a timestamp to a notation if possible *)
val to_notation : t -> string option

(* Convert a timestamp to a string representation of the seconds *)
val to_num_str : t -> string

(* Convert to a notation if possible, or num if not *)
val to_string : t -> string

val of_string : string -> t option

val diff : t -> t -> z num

val add_delta : t -> z num -> t

val sub_delta : t -> z num -> t

val to_zint : t -> Z.t

val of_zint : Z.t -> t

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Parameter t : Set.

Parameter of_int64 : int64 -> t.

Parameter compare : t -> t -> Z.

Parameter to_notation : t -> option string.

Parameter to_num_str : t -> string.

Parameter to_string : t -> string.

Parameter of_string : string -> option t.

Parameter diff :
  t -> t ->
  Tezos_raw_protocol_alpha.Script_int_repr.num
    Tezos_raw_protocol_alpha.Script_int_repr.z.

Parameter add_delta :
  t ->
  Tezos_raw_protocol_alpha.Script_int_repr.num
    Tezos_raw_protocol_alpha.Script_int_repr.z -> t.

Parameter sub_delta :
  t ->
  Tezos_raw_protocol_alpha.Script_int_repr.num
    Tezos_raw_protocol_alpha.Script_int_repr.z -> t.

Parameter to_zint : t -> Tezos_protocol_environment_alpha__Environment.Z.t.

Parameter of_zint : Tezos_protocol_environment_alpha__Environment.Z.t -> t.

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Alpha_context
open Script_int

(* ---- Auxiliary types -----------------------------------------------------*)

type var_annot = [`Var_annot of string]

type type_annot = [`Type_annot of string]

type field_annot = [`Field_annot of string]

type annot = [var_annot | type_annot | field_annot]

type address = Contract.t * string

type ('a, 'b) pair = 'a * 'b

type ('a, 'b) union = L of 'a | R of 'b

type comb = Comb

type leaf = Leaf

type (_, _) comparable_struct =
  | Int_key : type_annot option -> (z num, _) comparable_struct
  | Nat_key : type_annot option -> (n num, _) comparable_struct
  | String_key : type_annot option -> (string, _) comparable_struct
  | Bytes_key : type_annot option -> (MBytes.t, _) comparable_struct
  | Mutez_key : type_annot option -> (Tez.t, _) comparable_struct
  | Bool_key : type_annot option -> (bool, _) comparable_struct
  | Key_hash_key : type_annot option -> (public_key_hash, _) comparable_struct
  | Timestamp_key :
      type_annot option
      -> (Script_timestamp.t, _) comparable_struct
  | Address_key : type_annot option -> (address, _) comparable_struct
  | Pair_key :
      (('a, leaf) comparable_struct * field_annot option)
      * (('b, _) comparable_struct * field_annot option)
      * type_annot option
      -> (('a, 'b) pair, comb) comparable_struct

type 'a comparable_ty = ('a, comb) comparable_struct

module type Boxed_set = sig
  type elt

  val elt_ty : elt comparable_ty

  module OPS : S.SET with type elt = elt

  val boxed : OPS.t

  val size : int
end

type 'elt set = (module Boxed_set with type elt = 'elt)

module type Boxed_map = sig
  type key

  type value

  val key_ty : key comparable_ty

  module OPS : S.MAP with type key = key

  val boxed : value OPS.t * int
end

type ('key, 'value) map =
  (module Boxed_map with type key = 'key and type value = 'value)

type operation = packed_internal_operation * Contract.big_map_diff option

type ('arg, 'storage) script = {
  code : (('arg, 'storage) pair, (operation list, 'storage) pair) lambda;
  arg_type : 'arg ty;
  storage : 'storage;
  storage_type : 'storage ty;
  root_name : string option;
}

and end_of_stack = unit

and ('arg, 'ret) lambda =
  | Lam :
      ('arg * end_of_stack, 'ret * end_of_stack) descr * Script.node
      -> ('arg, 'ret) lambda

and 'arg typed_contract = 'arg ty * address

and 'ty ty =
  | Unit_t : type_annot option -> unit ty
  | Int_t : type_annot option -> z num ty
  | Nat_t : type_annot option -> n num ty
  | Signature_t : type_annot option -> signature ty
  | String_t : type_annot option -> string ty
  | Bytes_t : type_annot option -> MBytes.t ty
  | Mutez_t : type_annot option -> Tez.t ty
  | Key_hash_t : type_annot option -> public_key_hash ty
  | Key_t : type_annot option -> public_key ty
  | Timestamp_t : type_annot option -> Script_timestamp.t ty
  | Address_t : type_annot option -> address ty
  | Bool_t : type_annot option -> bool ty
  | Pair_t :
      ('a ty * field_annot option * var_annot option)
      * ('b ty * field_annot option * var_annot option)
      * type_annot option
      * bool
      -> ('a, 'b) pair ty
  | Union_t :
      ('a ty * field_annot option)
      * ('b ty * field_annot option)
      * type_annot option
      * bool
      -> ('a, 'b) union ty
  | Lambda_t : 'arg ty * 'ret ty * type_annot option -> ('arg, 'ret) lambda ty
  | Option_t : 'v ty * type_annot option * bool -> 'v option ty
  | List_t : 'v ty * type_annot option * bool -> 'v list ty
  | Set_t : 'v comparable_ty * type_annot option -> 'v set ty
  | Map_t :
      'k comparable_ty * 'v ty * type_annot option * bool
      -> ('k, 'v) map ty
  | Big_map_t :
      'k comparable_ty * 'v ty * type_annot option
      -> ('k, 'v) big_map ty
  | Contract_t : 'arg ty * type_annot option -> 'arg typed_contract ty
  | Operation_t : type_annot option -> operation ty
  | Chain_id_t : type_annot option -> Chain_id.t ty

and 'ty stack_ty =
  | Item_t :
      'ty ty * 'rest stack_ty * var_annot option
      -> ('ty * 'rest) stack_ty
  | Empty_t : end_of_stack stack_ty

and ('key, 'value) big_map = {
  id : Z.t option;
  diff : ('key, 'value option) map;
  key_type : 'key ty;
  value_type : 'value ty;
}

(* ---- Instructions --------------------------------------------------------*)

(* The low-level, typed instructions, as a GADT whose parameters
   encode the typing rules.

   The left parameter is the typed shape of the stack before the
   instruction, the right one the shape after. Any program whose
   construction is accepted by OCaml's type-checker is guaranteed to
   be type-safe. Overloadings of the concrete syntax are already
   resolved in this representation, either by using different
   constructors or type witness parameters. *)
and ('bef, 'aft) instr =
  (* stack ops *)
  | Drop : (_ * 'rest, 'rest) instr
  | Dup : ('top * 'rest, 'top * ('top * 'rest)) instr
  | Swap : ('tip * ('top * 'rest), 'top * ('tip * 'rest)) instr
  | Const : 'ty -> ('rest, 'ty * 'rest) instr
  (* pairs *)
  | Cons_pair : ('car * ('cdr * 'rest), ('car, 'cdr) pair * 'rest) instr
  | Car : (('car, _) pair * 'rest, 'car * 'rest) instr
  | Cdr : ((_, 'cdr) pair * 'rest, 'cdr * 'rest) instr
  (* options *)
  | Cons_some : ('v * 'rest, 'v option * 'rest) instr
  | Cons_none : 'a ty -> ('rest, 'a option * 'rest) instr
  | If_none :
      ('bef, 'aft) descr * ('a * 'bef, 'aft) descr
      -> ('a option * 'bef, 'aft) instr
  (* unions *)
  | Left : ('l * 'rest, ('l, 'r) union * 'rest) instr
  | Right : ('r * 'rest, ('l, 'r) union * 'rest) instr
  | If_left :
      ('l * 'bef, 'aft) descr * ('r * 'bef, 'aft) descr
      -> (('l, 'r) union * 'bef, 'aft) instr
  (* lists *)
  | Cons_list : ('a * ('a list * 'rest), 'a list * 'rest) instr
  | Nil : ('rest, 'a list * 'rest) instr
  | If_cons :
      ('a * ('a list * 'bef), 'aft) descr * ('bef, 'aft) descr
      -> ('a list * 'bef, 'aft) instr
  | List_map :
      ('a * 'rest, 'b * 'rest) descr
      -> ('a list * 'rest, 'b list * 'rest) instr
  | List_iter : ('a * 'rest, 'rest) descr -> ('a list * 'rest, 'rest) instr
  | List_size : ('a list * 'rest, n num * 'rest) instr
  (* sets *)
  | Empty_set : 'a comparable_ty -> ('rest, 'a set * 'rest) instr
  | Set_iter : ('a * 'rest, 'rest) descr -> ('a set * 'rest, 'rest) instr
  | Set_mem : ('elt * ('elt set * 'rest), bool * 'rest) instr
  | Set_update : ('elt * (bool * ('elt set * 'rest)), 'elt set * 'rest) instr
  | Set_size : ('a set * 'rest, n num * 'rest) instr
  (* maps *)
  | Empty_map : 'a comparable_ty * 'v ty -> ('rest, ('a, 'v) map * 'rest) instr
  | Map_map :
      (('a * 'v) * 'rest, 'r * 'rest) descr
      -> (('a, 'v) map * 'rest, ('a, 'r) map * 'rest) instr
  | Map_iter :
      (('a * 'v) * 'rest, 'rest) descr
      -> (('a, 'v) map * 'rest, 'rest) instr
  | Map_mem : ('a * (('a, 'v) map * 'rest), bool * 'rest) instr
  | Map_get : ('a * (('a, 'v) map * 'rest), 'v option * 'rest) instr
  | Map_update
      : ('a * ('v option * (('a, 'v) map * 'rest)), ('a, 'v) map * 'rest) instr
  | Map_size : (('a, 'b) map * 'rest, n num * 'rest) instr
  (* big maps *)
  | Empty_big_map :
      'a comparable_ty * 'v ty
      -> ('rest, ('a, 'v) big_map * 'rest) instr
  | Big_map_mem : ('a * (('a, 'v) big_map * 'rest), bool * 'rest) instr
  | Big_map_get : ('a * (('a, 'v) big_map * 'rest), 'v option * 'rest) instr
  | Big_map_update
      : ( 'key * ('value option * (('key, 'value) big_map * 'rest)),
          ('key, 'value) big_map * 'rest )
        instr
  (* string operations *)
  | Concat_string : (string list * 'rest, string * 'rest) instr
  | Concat_string_pair : (string * (string * 'rest), string * 'rest) instr
  | Slice_string
      : (n num * (n num * (string * 'rest)), string option * 'rest) instr
  | String_size : (string * 'rest, n num * 'rest) instr
  (* bytes operations *)
  | Concat_bytes : (MBytes.t list * 'rest, MBytes.t * 'rest) instr
  | Concat_bytes_pair : (MBytes.t * (MBytes.t * 'rest), MBytes.t * 'rest) instr
  | Slice_bytes
      : (n num * (n num * (MBytes.t * 'rest)), MBytes.t option * 'rest) instr
  | Bytes_size : (MBytes.t * 'rest, n num * 'rest) instr
  (* timestamp operations *)
  | Add_seconds_to_timestamp
      : ( z num * (Script_timestamp.t * 'rest),
          Script_timestamp.t * 'rest )
        instr
  | Add_timestamp_to_seconds
      : ( Script_timestamp.t * (z num * 'rest),
          Script_timestamp.t * 'rest )
        instr
  | Sub_timestamp_seconds
      : ( Script_timestamp.t * (z num * 'rest),
          Script_timestamp.t * 'rest )
        instr
  | Diff_timestamps
      : ( Script_timestamp.t * (Script_timestamp.t * 'rest),
          z num * 'rest )
        instr
  (* tez operations *)
  | Add_tez : (Tez.t * (Tez.t * 'rest), Tez.t * 'rest) instr
  | Sub_tez : (Tez.t * (Tez.t * 'rest), Tez.t * 'rest) instr
  | Mul_teznat : (Tez.t * (n num * 'rest), Tez.t * 'rest) instr
  | Mul_nattez : (n num * (Tez.t * 'rest), Tez.t * 'rest) instr
  | Ediv_teznat
      : (Tez.t * (n num * 'rest), (Tez.t, Tez.t) pair option * 'rest) instr
  | Ediv_tez
      : (Tez.t * (Tez.t * 'rest), (n num, Tez.t) pair option * 'rest) instr
  (* boolean operations *)
  | Or : (bool * (bool * 'rest), bool * 'rest) instr
  | And : (bool * (bool * 'rest), bool * 'rest) instr
  | Xor : (bool * (bool * 'rest), bool * 'rest) instr
  | Not : (bool * 'rest, bool * 'rest) instr
  (* integer operations *)
  | Is_nat : (z num * 'rest, n num option * 'rest) instr
  | Neg_nat : (n num * 'rest, z num * 'rest) instr
  | Neg_int : (z num * 'rest, z num * 'rest) instr
  | Abs_int : (z num * 'rest, n num * 'rest) instr
  | Int_nat : (n num * 'rest, z num * 'rest) instr
  | Add_intint : (z num * (z num * 'rest), z num * 'rest) instr
  | Add_intnat : (z num * (n num * 'rest), z num * 'rest) instr
  | Add_natint : (n num * (z num * 'rest), z num * 'rest) instr
  | Add_natnat : (n num * (n num * 'rest), n num * 'rest) instr
  | Sub_int : ('s num * ('t num * 'rest), z num * 'rest) instr
  | Mul_intint : (z num * (z num * 'rest), z num * 'rest) instr
  | Mul_intnat : (z num * (n num * 'rest), z num * 'rest) instr
  | Mul_natint : (n num * (z num * 'rest), z num * 'rest) instr
  | Mul_natnat : (n num * (n num * 'rest), n num * 'rest) instr
  | Ediv_intint
      : (z num * (z num * 'rest), (z num, n num) pair option * 'rest) instr
  | Ediv_intnat
      : (z num * (n num * 'rest), (z num, n num) pair option * 'rest) instr
  | Ediv_natint
      : (n num * (z num * 'rest), (z num, n num) pair option * 'rest) instr
  | Ediv_natnat
      : (n num * (n num * 'rest), (n num, n num) pair option * 'rest) instr
  | Lsl_nat : (n num * (n num * 'rest), n num * 'rest) instr
  | Lsr_nat : (n num * (n num * 'rest), n num * 'rest) instr
  | Or_nat : (n num * (n num * 'rest), n num * 'rest) instr
  | And_nat : (n num * (n num * 'rest), n num * 'rest) instr
  | And_int_nat : (z num * (n num * 'rest), n num * 'rest) instr
  | Xor_nat : (n num * (n num * 'rest), n num * 'rest) instr
  | Not_nat : (n num * 'rest, z num * 'rest) instr
  | Not_int : (z num * 'rest, z num * 'rest) instr
  (* control *)
  | Seq : ('bef, 'trans) descr * ('trans, 'aft) descr -> ('bef, 'aft) instr
  | If : ('bef, 'aft) descr * ('bef, 'aft) descr -> (bool * 'bef, 'aft) instr
  | Loop : ('rest, bool * 'rest) descr -> (bool * 'rest, 'rest) instr
  | Loop_left :
      ('a * 'rest, ('a, 'b) union * 'rest) descr
      -> (('a, 'b) union * 'rest, 'b * 'rest) instr
  | Dip : ('bef, 'aft) descr -> ('top * 'bef, 'top * 'aft) instr
  | Exec : ('arg * (('arg, 'ret) lambda * 'rest), 'ret * 'rest) instr
  | Apply :
      'arg ty
      -> ( 'arg * (('arg * 'remaining, 'ret) lambda * 'rest),
           ('remaining, 'ret) lambda * 'rest )
         instr
  | Lambda : ('arg, 'ret) lambda -> ('rest, ('arg, 'ret) lambda * 'rest) instr
  | Failwith : 'a ty -> ('a * 'rest, 'aft) instr
  | Nop : ('rest, 'rest) instr
  (* comparison *)
  | Compare : 'a comparable_ty -> ('a * ('a * 'rest), z num * 'rest) instr
  (* comparators *)
  | Eq : (z num * 'rest, bool * 'rest) instr
  | Neq : (z num * 'rest, bool * 'rest) instr
  | Lt : (z num * 'rest, bool * 'rest) instr
  | Gt : (z num * 'rest, bool * 'rest) instr
  | Le : (z num * 'rest, bool * 'rest) instr
  | Ge : (z num * 'rest, bool * 'rest) instr
  (* protocol *)
  | Address : (_ typed_contract * 'rest, address * 'rest) instr
  | Contract :
      'p ty * string
      -> (address * 'rest, 'p typed_contract option * 'rest) instr
  | Transfer_tokens
      : ( 'arg * (Tez.t * ('arg typed_contract * 'rest)),
          operation * 'rest )
        instr
  | Create_account
      : ( public_key_hash * (public_key_hash option * (bool * (Tez.t * 'rest))),
          operation * (address * 'rest) )
        instr
  | Implicit_account
      : (public_key_hash * 'rest, unit typed_contract * 'rest) instr
  | Create_contract :
      'g ty * 'p ty * ('p * 'g, operation list * 'g) lambda * string option
      -> ( public_key_hash
           * (public_key_hash option * (bool * (bool * (Tez.t * ('g * 'rest))))),
           operation * (address * 'rest) )
         instr
  | Create_contract_2 :
      'g ty * 'p ty * ('p * 'g, operation list * 'g) lambda * string option
      -> ( public_key_hash option * (Tez.t * ('g * 'rest)),
           operation * (address * 'rest) )
         instr
  | Set_delegate : (public_key_hash option * 'rest, operation * 'rest) instr
  | Now : ('rest, Script_timestamp.t * 'rest) instr
  | Balance : ('rest, Tez.t * 'rest) instr
  | Check_signature
      : (public_key * (signature * (MBytes.t * 'rest)), bool * 'rest) instr
  | Hash_key : (public_key * 'rest, public_key_hash * 'rest) instr
  | Pack : 'a ty -> ('a * 'rest, MBytes.t * 'rest) instr
  | Unpack : 'a ty -> (MBytes.t * 'rest, 'a option * 'rest) instr
  | Blake2b : (MBytes.t * 'rest, MBytes.t * 'rest) instr
  | Sha256 : (MBytes.t * 'rest, MBytes.t * 'rest) instr
  | Sha512 : (MBytes.t * 'rest, MBytes.t * 'rest) instr
  | Steps_to_quota
      : (* TODO: check that it always returns a nat *)
      ('rest, n num * 'rest) instr
  | Source : ('rest, address * 'rest) instr
  | Sender : ('rest, address * 'rest) instr
  | Self : 'p ty * string -> ('rest, 'p typed_contract * 'rest) instr
  | Amount : ('rest, Tez.t * 'rest) instr
  | Dig :
      int * ('x * 'rest, 'rest, 'bef, 'aft) stack_prefix_preservation_witness
      -> ('bef, 'x * 'aft) instr
  | Dug :
      int * ('rest, 'x * 'rest, 'bef, 'aft) stack_prefix_preservation_witness
      -> ('x * 'bef, 'aft) instr
  | Dipn :
      int
      * ('fbef, 'faft, 'bef, 'aft) stack_prefix_preservation_witness
      * ('fbef, 'faft) descr
      -> ('bef, 'aft) instr
  | Dropn :
      int * ('rest, 'rest, 'bef, _) stack_prefix_preservation_witness
      -> ('bef, 'rest) instr
  | ChainId : ('rest, Chain_id.t * 'rest) instr

(* Type witness for operations that work deep in the stack ignoring
   (and preserving) a prefix.

   The two right parameters are the shape of the stack with the (same)
   prefix before and after the transformation. The two left
   parameters are the shape of the stack without the prefix before and
   after. The inductive definition makes it so by construction. *)
and ('bef, 'aft, 'bef_suffix, 'aft_suffix) stack_prefix_preservation_witness =
  | Prefix :
      ('fbef, 'faft, 'bef, 'aft) stack_prefix_preservation_witness
      -> ('fbef, 'faft, 'x * 'bef, 'x * 'aft) stack_prefix_preservation_witness
  | Rest : ('bef, 'aft, 'bef, 'aft) stack_prefix_preservation_witness

and ('bef, 'aft) descr = {
  loc : Script.location;
  bef : 'bef stack_ty;
  aft : 'aft stack_ty;
  instr : ('bef, 'aft) instr;
}

type ex_big_map = Ex_bm : ('key, 'value) big_map -> ex_big_map

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Import Alpha_context.

Import Script_int.

Inductive var_annot : Set :=
| Var_annot : string -> var_annot.

Inductive type_annot : Set :=
| Type_annot : string -> type_annot.

Inductive field_annot : Set :=
| Field_annot : string -> field_annot.

Inductive annot : Set :=
| Field_annot : string -> annot
| Var_annot : string -> annot
| Type_annot : string -> annot.

Definition address :=
  Tezos_raw_protocol_alpha.Alpha_context.Contract.t * string.

Definition pair (a b : Set) := a * b.

Inductive union (a b : Set) : Set :=
| L : a -> union a b
| R : b -> union a b.

Arguments L {_ _}.
Arguments R {_ _}.

Inductive comb : Set :=
| Comb : comb.

Inductive leaf : Set :=
| Leaf : leaf.

Reserved Notation "'comparable_struct".

Inductive comparable_struct_gadt : Set :=
| Int_key : option type_annot -> comparable_struct_gadt
| Nat_key : option type_annot -> comparable_struct_gadt
| String_key : option type_annot -> comparable_struct_gadt
| Bytes_key : option type_annot -> comparable_struct_gadt
| Mutez_key : option type_annot -> comparable_struct_gadt
| Bool_key : option type_annot -> comparable_struct_gadt
| Key_hash_key : option type_annot -> comparable_struct_gadt
| Timestamp_key : option type_annot -> comparable_struct_gadt
| Address_key : option type_annot -> comparable_struct_gadt
| Pair_key :
  comparable_struct_gadt * option field_annot ->
  comparable_struct_gadt * option field_annot -> option type_annot ->
  comparable_struct_gadt

where "'comparable_struct" := (fun (_ _ : Set) => comparable_struct_gadt).

Definition comparable_struct := 'comparable_struct.

Definition comparable_ty (a : Set) := comparable_struct a comb.

Module Boxed_set.
  Record signature {elt OPS_t : Set} := {
    elt := elt;
    elt_ty : comparable_ty elt;
    OPS : S.SET.signature elt OPS_t;
    boxed : OPS.(Tezos_protocol_environment_alpha__Environment.S.SET.t);
    size : Z;
  }.
  Arguments signature : clear implicits.
End Boxed_set.

Definition set (elt : Set) := {OPS_t : _ & Boxed_set.signature elt OPS_t}.

Module Boxed_map.
  Record signature {key value : Set} {OPS_t : Set -> Set} := {
    key := key;
    value := value;
    key_ty : comparable_ty key;
    OPS : S.MAP.signature key OPS_t;
    boxed :
      OPS.(Tezos_protocol_environment_alpha__Environment.S.MAP.t) value * Z;
  }.
  Arguments signature : clear implicits.
End Boxed_map.

Definition map (key value : Set) :=
  {OPS_t : _ & Boxed_map.signature key value OPS_t}.

Definition operation :=
  Tezos_raw_protocol_alpha.Alpha_context.packed_internal_operation *
    option Tezos_raw_protocol_alpha.Alpha_context.Contract.big_map_diff.

Reserved Notation "'script".
Reserved Notation "'end_of_stack".
Reserved Notation "'lambda".
Reserved Notation "'typed_contract".
Reserved Notation "'ty".
Reserved Notation "'stack_ty".
Reserved Notation "'big_map".
Reserved Notation "'instr".
Reserved Notation "'stack_prefix_preservation_witness".
Reserved Notation "'descr".

Module descr_skeleton.
  Record record {loc bef aft instr : Set} := {
    loc : loc;
    bef : bef;
    aft : aft;
    instr : instr }.
  Arguments record : clear implicits.
End descr_skeleton.
Definition descr_skeleton := descr_skeleton.record.

Module big_map_skeleton.
  Record record {id diff key_type value_type : Set} := {
    id : id;
    diff : diff;
    key_type : key_type;
    value_type : value_type }.
  Arguments record : clear implicits.
End big_map_skeleton.
Definition big_map_skeleton := big_map_skeleton.record.

Module script_skeleton.
  Record record {code arg_type storage storage_type root_name : Set} := {
    code : code;
    arg_type : arg_type;
    storage : storage;
    storage_type : storage_type;
    root_name : root_name }.
  Arguments record : clear implicits.
End script_skeleton.
Definition script_skeleton := script_skeleton.record.

Inductive lambda_gadt : Set :=
| Lam : forall {arg ret : Set},
  'descr (arg * 'end_of_stack) (ret * 'end_of_stack) ->
  Tezos_raw_protocol_alpha.Alpha_context.Script.node -> lambda_gadt

with ty_gadt : Set :=
| Unit_t : option type_annot -> ty_gadt
| Int_t : option type_annot -> ty_gadt
| Nat_t : option type_annot -> ty_gadt
| Signature_t : option type_annot -> ty_gadt
| String_t : option type_annot -> ty_gadt
| Bytes_t : option type_annot -> ty_gadt
| Mutez_t : option type_annot -> ty_gadt
| Key_hash_t : option type_annot -> ty_gadt
| Key_t : option type_annot -> ty_gadt
| Timestamp_t : option type_annot -> ty_gadt
| Address_t : option type_annot -> ty_gadt
| Bool_t : option type_annot -> ty_gadt
| Pair_t :
  ty_gadt * option field_annot * option var_annot ->
  ty_gadt * option field_annot * option var_annot -> option type_annot ->
  bool -> ty_gadt
| Union_t :
  ty_gadt * option field_annot -> ty_gadt * option field_annot ->
  option type_annot -> bool -> ty_gadt
| Lambda_t : ty_gadt -> ty_gadt -> option type_annot -> ty_gadt
| Option_t : ty_gadt -> option type_annot -> bool -> ty_gadt
| List_t : ty_gadt -> option type_annot -> bool -> ty_gadt
| Set_t : forall {v : Set}, comparable_ty v -> option type_annot -> ty_gadt
| Map_t : forall {k : Set},
  comparable_ty k -> ty_gadt -> option type_annot -> bool -> ty_gadt
| Big_map_t : forall {k : Set},
  comparable_ty k -> ty_gadt -> option type_annot -> ty_gadt
| Contract_t : ty_gadt -> option type_annot -> ty_gadt
| Operation_t : option type_annot -> ty_gadt
| Chain_id_t : option type_annot -> ty_gadt

with stack_ty_gadt : Set :=
| Item_t : forall {ty : Set},
  'ty ty -> stack_ty_gadt -> option var_annot -> stack_ty_gadt
| Empty_t : stack_ty_gadt

with instr_gadt : Set :=
| Drop : instr_gadt
| Dup : instr_gadt
| Swap : instr_gadt
| Const : forall {ty : Set}, ty -> instr_gadt
| Cons_pair : instr_gadt
| Car : instr_gadt
| Cdr : instr_gadt
| Cons_some : instr_gadt
| Cons_none : forall {a : Set}, 'ty a -> instr_gadt
| If_none : forall {a aft bef : Set},
  'descr bef aft -> 'descr (a * bef) aft -> instr_gadt
| Left : instr_gadt
| Right : instr_gadt
| If_left : forall {aft bef l r : Set},
  'descr (l * bef) aft -> 'descr (r * bef) aft -> instr_gadt
| Cons_list : instr_gadt
| Nil : instr_gadt
| If_cons : forall {a aft bef : Set},
  'descr (a * (list a * bef)) aft -> 'descr bef aft -> instr_gadt
| List_map : forall {a b rest : Set}, 'descr (a * rest) (b * rest) -> instr_gadt
| List_iter : forall {a rest : Set}, 'descr (a * rest) rest -> instr_gadt
| List_size : instr_gadt
| Empty_set : forall {a : Set}, comparable_ty a -> instr_gadt
| Set_iter : forall {a rest : Set}, 'descr (a * rest) rest -> instr_gadt
| Set_mem : instr_gadt
| Set_update : instr_gadt
| Set_size : instr_gadt
| Empty_map : forall {a v : Set}, comparable_ty a -> 'ty v -> instr_gadt
| Map_map : forall {a r rest v : Set},
  'descr ((a * v) * rest) (r * rest) -> instr_gadt
| Map_iter : forall {a rest v : Set}, 'descr ((a * v) * rest) rest -> instr_gadt
| Map_mem : instr_gadt
| Map_get : instr_gadt
| Map_update : instr_gadt
| Map_size : instr_gadt
| Empty_big_map : forall {a v : Set}, comparable_ty a -> 'ty v -> instr_gadt
| Big_map_mem : instr_gadt
| Big_map_get : instr_gadt
| Big_map_update : instr_gadt
| Concat_string : instr_gadt
| Concat_string_pair : instr_gadt
| Slice_string : instr_gadt
| String_size : instr_gadt
| Concat_bytes : instr_gadt
| Concat_bytes_pair : instr_gadt
| Slice_bytes : instr_gadt
| Bytes_size : instr_gadt
| Add_seconds_to_timestamp : instr_gadt
| Add_timestamp_to_seconds : instr_gadt
| Sub_timestamp_seconds : instr_gadt
| Diff_timestamps : instr_gadt
| Add_tez : instr_gadt
| Sub_tez : instr_gadt
| Mul_teznat : instr_gadt
| Mul_nattez : instr_gadt
| Ediv_teznat : instr_gadt
| Ediv_tez : instr_gadt
| Or : instr_gadt
| And : instr_gadt
| Xor : instr_gadt
| Not : instr_gadt
| Is_nat : instr_gadt
| Neg_nat : instr_gadt
| Neg_int : instr_gadt
| Abs_int : instr_gadt
| Int_nat : instr_gadt
| Add_intint : instr_gadt
| Add_intnat : instr_gadt
| Add_natint : instr_gadt
| Add_natnat : instr_gadt
| Sub_int : instr_gadt
| Mul_intint : instr_gadt
| Mul_intnat : instr_gadt
| Mul_natint : instr_gadt
| Mul_natnat : instr_gadt
| Ediv_intint : instr_gadt
| Ediv_intnat : instr_gadt
| Ediv_natint : instr_gadt
| Ediv_natnat : instr_gadt
| Lsl_nat : instr_gadt
| Lsr_nat : instr_gadt
| Or_nat : instr_gadt
| And_nat : instr_gadt
| And_int_nat : instr_gadt
| Xor_nat : instr_gadt
| Not_nat : instr_gadt
| Not_int : instr_gadt
| Seq : forall {aft bef trans : Set},
  'descr bef trans -> 'descr trans aft -> instr_gadt
| If : forall {aft bef : Set}, 'descr bef aft -> 'descr bef aft -> instr_gadt
| Loop : forall {rest : Set}, 'descr rest (bool * rest) -> instr_gadt
| Loop_left : forall {a b rest : Set},
  'descr (a * rest) (union a b * rest) -> instr_gadt
| Dip : forall {aft bef : Set}, 'descr bef aft -> instr_gadt
| Exec : instr_gadt
| Apply : forall {arg : Set}, 'ty arg -> instr_gadt
| Lambda : forall {arg ret : Set}, 'lambda arg ret -> instr_gadt
| Failwith : forall {a : Set}, 'ty a -> instr_gadt
| Nop : instr_gadt
| Compare : forall {a : Set}, comparable_ty a -> instr_gadt
| Eq : instr_gadt
| Neq : instr_gadt
| Lt : instr_gadt
| Gt : instr_gadt
| Le : instr_gadt
| Ge : instr_gadt
| Address : instr_gadt
| Contract : forall {p : Set}, 'ty p -> string -> instr_gadt
| Transfer_tokens : instr_gadt
| Create_account : instr_gadt
| Implicit_account : instr_gadt
| Create_contract : forall {g p : Set},
  'ty g -> 'ty p -> 'lambda (p * g) (list operation * g) -> option string ->
  instr_gadt
| Create_contract_2 : forall {g p : Set},
  'ty g -> 'ty p -> 'lambda (p * g) (list operation * g) -> option string ->
  instr_gadt
| Set_delegate : instr_gadt
| Now : instr_gadt
| Balance : instr_gadt
| Check_signature : instr_gadt
| Hash_key : instr_gadt
| Pack : forall {a : Set}, 'ty a -> instr_gadt
| Unpack : forall {a : Set}, 'ty a -> instr_gadt
| Blake2b : instr_gadt
| Sha256 : instr_gadt
| Sha512 : instr_gadt
| Steps_to_quota : instr_gadt
| Source : instr_gadt
| Sender : instr_gadt
| Self : forall {p : Set}, 'ty p -> string -> instr_gadt
| Amount : instr_gadt
| Dig : forall {aft bef rest x : Set},
  Z -> 'stack_prefix_preservation_witness (x * rest) rest bef aft -> instr_gadt
| Dug : forall {aft bef rest x : Set},
  Z -> 'stack_prefix_preservation_witness rest (x * rest) bef aft -> instr_gadt
| Dipn : forall {aft bef faft fbef : Set},
  Z -> 'stack_prefix_preservation_witness fbef faft bef aft ->
  'descr fbef faft -> instr_gadt
| Dropn : forall {C bef rest : Set},
  Z -> 'stack_prefix_preservation_witness rest rest bef C -> instr_gadt
| ChainId : instr_gadt

with stack_prefix_preservation_witness_gadt : Set :=
| Prefix :
  stack_prefix_preservation_witness_gadt ->
  stack_prefix_preservation_witness_gadt
| Rest : stack_prefix_preservation_witness_gadt

where "'script" := (fun (arg storage : Set) =>
  script_skeleton ('lambda (pair arg storage) (pair (list operation) storage))
    ('ty arg) storage ('ty storage) (option string))
and "'end_of_stack" := (unit)
and "'lambda" := (fun (arg ret : Set) => lambda_gadt)
and "'typed_contract" := (fun (arg : Set) => 'ty arg * address)
and "'ty" := (fun (ty : Set) => ty_gadt)
and "'stack_ty" := (fun (ty : Set) => stack_ty_gadt)
and "'big_map" := (fun (key value : Set) =>
  big_map_skeleton (option Tezos_protocol_environment_alpha__Environment.Z.t)
    (map key (option value)) ('ty key) ('ty value))
and "'instr" := (fun (bef aft : Set) => instr_gadt)
and "'stack_prefix_preservation_witness" := (fun
  (bef aft bef_suffix aft_suffix : Set) =>
  stack_prefix_preservation_witness_gadt)
and "'descr" := (fun (bef aft : Set) =>
  descr_skeleton Tezos_raw_protocol_alpha.Alpha_context.Script.location
    ('stack_ty bef) ('stack_ty aft) ('instr bef aft)).

Definition script := 'script.
Definition end_of_stack := 'end_of_stack.
Definition lambda := 'lambda.
Definition typed_contract := 'typed_contract.
Definition ty := 'ty.
Definition stack_ty := 'stack_ty.
Definition big_map := 'big_map.
Definition instr := 'instr.
Definition stack_prefix_preservation_witness :=
  'stack_prefix_preservation_witness.
Definition descr := 'descr.

Reserved Notation "'ex_big_map".

Inductive ex_big_map_gadt : Set :=
| Ex_bm : forall {key value : Set}, big_map key value -> ex_big_map_gadt

where "'ex_big_map" := (ex_big_map_gadt).

Definition ex_big_map := 'ex_big_map.

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

(* Tezos Protocol Implementation - Random number generation *)

type seed = B of State_hash.t

type t = T of State_hash.t

type sequence = S of State_hash.t

type nonce = MBytes.t

let nonce_encoding = Data_encoding.Fixed.bytes Constants_repr.nonce_length

let init = "Laissez-faire les proprietaires."

let zero_bytes = MBytes.of_string (String.make Nonce_hash.size '\000')

let state_hash_encoding =
  let open Data_encoding in
  conv
    State_hash.to_bytes
    State_hash.of_bytes_exn
    (Fixed.bytes Nonce_hash.size)

let seed_encoding =
  let open Data_encoding in
  conv (fun (B b) -> b) (fun b -> B b) state_hash_encoding

let empty = B (State_hash.hash_bytes [MBytes.of_string init])

let nonce (B state) nonce =
  B (State_hash.hash_bytes [State_hash.to_bytes state; nonce])

let initialize_new (B state) append =
  T (State_hash.hash_bytes (State_hash.to_bytes state :: zero_bytes :: append))

let xor_higher_bits i b =
  let higher = MBytes.get_int32 b 0 in
  let r = Int32.logxor higher i in
  let res = MBytes.copy b in
  MBytes.set_int32 res 0 r ; res

let sequence (T state) n =
  State_hash.to_bytes state |> xor_higher_bits n
  |> fun b -> S (State_hash.hash_bytes [b])

let take (S state) =
  let b = State_hash.to_bytes state in
  let h = State_hash.hash_bytes [b] in
  (State_hash.to_bytes h, S h)

let take_int32 s bound =
  if Compare.Int32.(bound <= 0l) then invalid_arg "Seed_repr.take_int32"
    (* FIXME *)
  else
    let rec loop s =
      let (bytes, s) = take s in
      let r = Int32.abs (MBytes.get_int32 bytes 0) in
      let drop_if_over =
        Int32.sub Int32.max_int (Int32.rem Int32.max_int bound)
      in
      if Compare.Int32.(r >= drop_if_over) then loop s
      else
        let v = Int32.rem r bound in
        (v, s)
    in
    loop s

type error += Unexpected_nonce_length (* `Permanent *)

let () =
  register_error_kind
    `Permanent
    ~id:"unexpected_nonce_length"
    ~title:"Unexpected nonce length"
    ~description:"Nonce length is incorrect."
    ~pp:(fun ppf () ->
      Format.fprintf
        ppf
        "Nonce length is not %i bytes long as it should."
        Constants_repr.nonce_length)
    Data_encoding.empty
    (function Unexpected_nonce_length -> Some () | _ -> None)
    (fun () -> Unexpected_nonce_length)

let make_nonce nonce =
  if Compare.Int.(MBytes.length nonce <> Constants_repr.nonce_length) then
    error Unexpected_nonce_length
  else ok nonce

let hash nonce = Nonce_hash.hash_bytes [nonce]

let check_hash nonce hash =
  Compare.Int.(MBytes.length nonce = Constants_repr.nonce_length)
  && Nonce_hash.equal (Nonce_hash.hash_bytes [nonce]) hash

let nonce_hash_key_part = Nonce_hash.to_path

let initial_nonce_0 = zero_bytes

let initial_nonce_hash_0 = hash initial_nonce_0

let deterministic_seed seed = nonce seed zero_bytes

let initial_seeds n =
  let rec loop acc elt i =
    if Compare.Int.(i = 1) then List.rev (elt :: acc)
    else loop (elt :: acc) (deterministic_seed elt) (i - 1)
  in
  loop [] (B (State_hash.hash_bytes [])) n

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Inductive seed : Set :=
| B : Tezos_raw_protocol_alpha.State_hash.t -> seed.

Inductive t : Set :=
| T : Tezos_raw_protocol_alpha.State_hash.t -> t.

Inductive sequence : Set :=
| S : Tezos_raw_protocol_alpha.State_hash.t -> sequence.

Definition nonce := Tezos_protocol_environment_alpha__Environment.MBytes.t.

Definition nonce_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    Tezos_protocol_environment_alpha__Environment.MBytes.t :=
  Data_encoding.Fixed.__bytes_value Constants_repr.nonce_length.

Definition init : string := "Laissez-faire les proprietaires." % string.

Definition zero_bytes
  : Tezos_protocol_environment_alpha__Environment.MBytes.t :=
  MBytes.of_string (String.make Nonce_hash.size "000" % char).

Definition state_hash_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    Tezos_raw_protocol_alpha.State_hash.t :=
  conv State_hash.to_bytes State_hash.of_bytes_exn None
    (Fixed.__bytes_value Nonce_hash.size).

Definition seed_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding seed :=
  conv
    (fun function_parameter =>
      let 'B b := function_parameter in
      b) (fun b => B b) None state_hash_encoding.

Definition empty : seed :=
  B (State_hash.hash_bytes None (cons (MBytes.of_string init) [])).

Definition nonce (function_parameter : seed)
  : Tezos_protocol_environment_alpha__Environment.MBytes.t -> seed :=
  let 'B state := function_parameter in
  fun nonce =>
    B
      (State_hash.hash_bytes None
        (cons (State_hash.to_bytes state) (cons nonce []))).

Definition initialize_new (function_parameter : seed)
  : list Tezos_protocol_environment_alpha__Environment.MBytes.t -> t :=
  let 'B state := function_parameter in
  fun append =>
    T
      (State_hash.hash_bytes None
        (cons (State_hash.to_bytes state) (cons zero_bytes append))).

Definition xor_higher_bits
  (i : int32) (b : Tezos_protocol_environment_alpha__Environment.MBytes.t)
  : Tezos_protocol_environment_alpha__Environment.MBytes.t :=
  let higher := MBytes.get_int32 b 0 in
  let r := Int32.logxor higher i in
  let res := MBytes.copy b in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ := MBytes.set_int32 res 0 r in
  res.

Definition sequence (function_parameter : t) : int32 -> sequence :=
  let 'T state := function_parameter in
  fun n =>
    op_pipegt (op_pipegt (State_hash.to_bytes state) (xor_higher_bits n))
      (fun b => S (State_hash.hash_bytes None (cons b []))).

Definition take (function_parameter : sequence)
  : Tezos_protocol_environment_alpha__Environment.MBytes.t * sequence :=
  let 'S state := function_parameter in
  let b := State_hash.to_bytes state in
  let h := State_hash.hash_bytes None (cons b []) in
  ((State_hash.to_bytes h), (S h)).

Definition take_int32
  (s : sequence)
  (bound : Tezos_protocol_environment_alpha__Environment.Compare.Int32.t)
  : int32 * sequence :=
  if
    op_lteq bound
      (* ❌ Constant of type int32 is converted to int *)
      0 then
    invalid_arg "Seed_repr.take_int32" % string
  else
    let fix loop (s : sequence) : int32 * sequence :=
      let '(__bytes_value, s) := take s in
      let r := Int32.abs (MBytes.get_int32 __bytes_value 0) in
      let drop_if_over :=
        Int32.sub Int32.max_int (Int32.rem Int32.max_int bound) in
      if op_gteq r drop_if_over then
        loop s
      else
        let v := Int32.rem r bound in
        (v, s) in
    loop s.

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Top-level evaluations are considered as an error as sources of side-effects *)
Compute
  register_error_kind
    (* ❌ Variants not supported *)
    variant "unexpected_nonce_length" % string
    "Unexpected nonce length" % string "Nonce length is incorrect." % string
    (Some
      (fun ppf =>
        fun function_parameter =>
          let 'tt := function_parameter in
          Format.fprintf ppf
            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                "Nonce length is not " % string
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int_i
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_precision
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                    " bytes long as it should." % string
                    Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))
              "Nonce length is not %i bytes long as it should." % string)
            Constants_repr.nonce_length)) Data_encoding.empty
    (fun function_parameter =>
      match function_parameter with
      |
        Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_nonce_length
        => Some tt
      | _ => None
      end)
    (fun function_parameter =>
      let 'tt := function_parameter in
      Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_nonce_length).

Definition make_nonce
  (nonce : Tezos_protocol_environment_alpha__Environment.MBytes.t)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    Tezos_protocol_environment_alpha__Environment.MBytes.t :=
  if op_ltgt (MBytes.length nonce) Constants_repr.nonce_length then
    __error_value
      Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_nonce_length
  else
    ok nonce.

Definition __hash_value
  (nonce : Tezos_protocol_environment_alpha__Environment.MBytes.t)
  : Tezos_raw_protocol_alpha.Nonce_hash.t :=
  Nonce_hash.hash_bytes None (cons nonce []).

Definition check_hash
  (nonce : Tezos_protocol_environment_alpha__Environment.MBytes.t)
  (__hash_value : Tezos_raw_protocol_alpha.Nonce_hash.t) : bool :=
  op_andand (op_eq (MBytes.length nonce) Constants_repr.nonce_length)
    (Nonce_hash.equal (Nonce_hash.hash_bytes None (cons nonce [])) __hash_value).

Definition nonce_hash_key_part
  : Tezos_raw_protocol_alpha.Nonce_hash.t -> list string -> list string :=
  Nonce_hash.to_path.

Definition initial_nonce_0
  : Tezos_protocol_environment_alpha__Environment.MBytes.t := zero_bytes.

Definition initial_nonce_hash_0 : Tezos_raw_protocol_alpha.Nonce_hash.t :=
  __hash_value initial_nonce_0.

Definition deterministic_seed (seed : seed) : seed := nonce seed zero_bytes.

Definition initial_seeds
  (n : Tezos_protocol_environment_alpha__Environment.Compare.Int.t)
  : list seed :=
  let fix loop
    (acc : list seed) (elt : seed) (i :
    Tezos_protocol_environment_alpha__Environment.Compare.Int.t) : list seed :=
    if op_eq i 1 then
      List.rev (cons elt acc)
    else
      loop (cons elt acc) (deterministic_seed elt) (op_minus i 1) in
  loop [] (B (State_hash.hash_bytes None [])) n.

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

(** Tezos Protocol Implementation - Random number generation

    This is not expected to be a good cryptographic random number
    generator. In particular this is supposed to be used in situations
    where the seed is a globaly known information.

    The only expected property is: It should be difficult to find a
    seed such that the generated sequence is a given one. *)

(** {2 Random Generation} *)

(** The state of the random number generator *)
type t

(** A random seed, to derive random sequences from *)
type seed

(** A random sequence, to derive random values from *)
type sequence

(** [initialize_new state ident] returns a new generator *)
val initialize_new : seed -> MBytes.t list -> t

(** [sequence state n] prepares the n-th sequence of a state  *)
val sequence : t -> int32 -> sequence

(** Generates the next random value in the sequence *)
val take : sequence -> MBytes.t * sequence

(** Generates the next random value as a bounded [int32] *)
val take_int32 : sequence -> int32 -> int32 * sequence

(** {2 Predefined seeds} *)

val empty : seed

(** Returns a new seed by hashing the one passed with a constant. *)
val deterministic_seed : seed -> seed

(** [intial_seeds n] generates the first [n] seeds for which there are no nonces.
    The first seed is a constant value. The kth seed is the hash of seed (k-1)
    concatenated with a constant. *)
val initial_seeds : int -> seed list

(** {2 Entropy} *)

(** A nonce for adding entropy to the generator *)
type nonce

(** Add entropy to the seed generator *)
val nonce : seed -> nonce -> seed

(** Use a byte sequence as a nonce *)
val make_nonce : MBytes.t -> nonce tzresult

(** Compute the has of a nonce *)
val hash : nonce -> Nonce_hash.t

(** [check_hash nonce hash] is true if the nonce correspond to the hash *)
val check_hash : nonce -> Nonce_hash.t -> bool

(** For using nonce hashes as keys in the hierarchical database *)
val nonce_hash_key_part : Nonce_hash.t -> string list -> string list

(** {2 Predefined nonce} *)

val initial_nonce_0 : nonce

val initial_nonce_hash_0 : Nonce_hash.t

(** {2 Serializers} *)

val nonce_encoding : nonce Data_encoding.t

val seed_encoding : seed Data_encoding.t

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Parameter t : Set.

Parameter seed : Set.

Parameter sequence : Set.

Parameter initialize_new :
  seed -> list Tezos_protocol_environment_alpha__Environment.MBytes.t -> t.

Parameter sequence : t -> int32 -> sequence.

Parameter take :
  sequence -> Tezos_protocol_environment_alpha__Environment.MBytes.t * sequence.

Parameter take_int32 : sequence -> int32 -> int32 * sequence.

Parameter empty : seed.

Parameter deterministic_seed : seed -> seed.

Parameter initial_seeds : Z -> list seed.

Parameter nonce : Set.

Parameter nonce : seed -> nonce -> seed.

Parameter make_nonce :
  Tezos_protocol_environment_alpha__Environment.MBytes.t ->
  Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult nonce.

Parameter __hash_value : nonce -> Tezos_raw_protocol_alpha.Nonce_hash.t.

Parameter check_hash : nonce -> Tezos_raw_protocol_alpha.Nonce_hash.t -> bool.

Parameter nonce_hash_key_part :
  Tezos_raw_protocol_alpha.Nonce_hash.t -> list string -> list string.

Parameter initial_nonce_0 : nonce.

Parameter initial_nonce_hash_0 : Tezos_raw_protocol_alpha.Nonce_hash.t.

Parameter nonce_encoding :
  Tezos_protocol_environment_alpha__Environment.Data_encoding.t nonce.

Parameter seed_encoding :
  Tezos_protocol_environment_alpha__Environment.Data_encoding.t seed.

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Misc

type error +=
  | Unknown of {
      oldest : Cycle_repr.t;
      cycle : Cycle_repr.t;
      latest : Cycle_repr.t;
    }

(* `Permanent *)

let () =
  register_error_kind
    `Permanent
    ~id:"seed.unknown_seed"
    ~title:"Unknown seed"
    ~description:"The requested seed is not available"
    ~pp:(fun ppf (oldest, cycle, latest) ->
      if Cycle_repr.(cycle < oldest) then
        Format.fprintf
          ppf
          "The seed for cycle %a has been cleared from the context  (oldest \
           known seed is for cycle %a)"
          Cycle_repr.pp
          cycle
          Cycle_repr.pp
          oldest
      else
        Format.fprintf
          ppf
          "The seed for cycle %a has not been computed yet  (latest known \
           seed is for cycle %a)"
          Cycle_repr.pp
          cycle
          Cycle_repr.pp
          latest)
    Data_encoding.(
      obj3
        (req "oldest" Cycle_repr.encoding)
        (req "requested" Cycle_repr.encoding)
        (req "latest" Cycle_repr.encoding))
    (function
      | Unknown {oldest; cycle; latest} ->
          Some (oldest, cycle, latest)
      | _ ->
          None)
    (fun (oldest, cycle, latest) -> Unknown {oldest; cycle; latest})

let compute_for_cycle c ~revealed cycle =
  match Cycle_repr.pred cycle with
  | None ->
      assert false (* should not happen *)
  | Some previous_cycle ->
      let levels = Level_storage.levels_with_commitments_in_cycle c revealed in
      let combine (c, random_seed, unrevealed) level =
        Storage.Seed.Nonce.get c level
        >>=? function
        | Revealed nonce ->
            Storage.Seed.Nonce.delete c level
            >>=? fun c ->
            return (c, Seed_repr.nonce random_seed nonce, unrevealed)
        | Unrevealed u ->
            Storage.Seed.Nonce.delete c level
            >>=? fun c -> return (c, random_seed, u :: unrevealed)
      in
      Storage.Seed.For_cycle.get c previous_cycle
      >>=? fun prev_seed ->
      let seed = Seed_repr.deterministic_seed prev_seed in
      fold_left_s combine (c, seed, []) levels
      >>=? fun (c, seed, unrevealed) ->
      Storage.Seed.For_cycle.init c cycle seed
      >>=? fun c -> return (c, unrevealed)

let for_cycle ctxt cycle =
  let preserved = Constants_storage.preserved_cycles ctxt in
  let current_level = Level_storage.current ctxt in
  let current_cycle = current_level.cycle in
  let latest =
    if Cycle_repr.(current_cycle = root) then
      Cycle_repr.add current_cycle (preserved + 1)
    else Cycle_repr.add current_cycle preserved
  in
  let oldest =
    match Cycle_repr.sub current_cycle preserved with
    | None ->
        Cycle_repr.root
    | Some oldest ->
        oldest
  in
  fail_unless
    Cycle_repr.(oldest <= cycle && cycle <= latest)
    (Unknown {oldest; cycle; latest})
  >>=? fun () -> Storage.Seed.For_cycle.get ctxt cycle

let clear_cycle c cycle = Storage.Seed.For_cycle.delete c cycle

let init ctxt =
  let preserved = Constants_storage.preserved_cycles ctxt in
  List.fold_left2
    (fun ctxt c seed ->
      ctxt
      >>=? fun ctxt ->
      let cycle = Cycle_repr.of_int32_exn (Int32.of_int c) in
      Storage.Seed.For_cycle.init ctxt cycle seed)
    (return ctxt)
    (0 --> (preserved + 1))
    (Seed_repr.initial_seeds (preserved + 2))

let cycle_end ctxt last_cycle =
  let preserved = Constants_storage.preserved_cycles ctxt in
  ( match Cycle_repr.sub last_cycle preserved with
  | None ->
      return ctxt
  | Some cleared_cycle ->
      clear_cycle ctxt cleared_cycle )
  >>=? fun ctxt ->
  match Cycle_repr.pred last_cycle with
  | None ->
      return (ctxt, [])
  | Some revealed ->
      (* cycle with revelations *)
      let inited_seed_cycle = Cycle_repr.add last_cycle (preserved + 1) in
      compute_for_cycle ctxt ~revealed inited_seed_cycle

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Import Misc.

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Top-level evaluations are considered as an error as sources of side-effects *)
Compute
  register_error_kind
    (* ❌ Variants not supported *)
    variant "seed.unknown_seed" % string "Unknown seed" % string
    "The requested seed is not available" % string
    (Some
      (fun ppf =>
        fun function_parameter =>
          let '(oldest, cycle, latest) := function_parameter in
          if op_lt cycle oldest then
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "The seed for cycle " % string
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                      " has been cleared from the context  (oldest known seed is for cycle "
                        % string
                      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Char_literal
                          ")" % char
                          Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))))
                "The seed for cycle %a has been cleared from the context  (oldest known seed is for cycle %a)"
                  % string) Cycle_repr.pp cycle Cycle_repr.pp oldest
          else
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "The seed for cycle " % string
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                      " has not been computed yet  (latest known seed is for cycle "
                        % string
                      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Char_literal
                          ")" % char
                          Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))))
                "The seed for cycle %a has not been computed yet  (latest known seed is for cycle %a)"
                  % string) Cycle_repr.pp cycle Cycle_repr.pp latest))
    (obj3 (req None None "oldest" % string Cycle_repr.encoding)
      (req None None "requested" % string Cycle_repr.encoding)
      (req None None "latest" % string Cycle_repr.encoding))
    (fun function_parameter =>
      match function_parameter with
      |
        Tezos_protocol_environment_alpha__Environment.Error_monad.Unknown {|
          Unknown.oldest := oldest;
            Unknown.cycle := cycle;
            Unknown.latest := latest
            |} => Some (oldest, cycle, latest)
      | _ => None
      end)
    (fun function_parameter =>
      let '(oldest, cycle, latest) := function_parameter in
      Tezos_protocol_environment_alpha__Environment.Error_monad.Unknown
        {| Unknown.oldest := oldest; Unknown.cycle := cycle;
          Unknown.latest := latest |}).

Definition compute_for_cycle
  (c : Tezos_raw_protocol_alpha.Raw_context.t)
  (revealed : Tezos_raw_protocol_alpha.Cycle_repr.t)
  (cycle : Tezos_raw_protocol_alpha.Cycle_repr.cycle)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Raw_context.t *
        list Tezos_raw_protocol_alpha__Storage.Seed.unrevealed_nonce)) :=
  match Cycle_repr.pred cycle with
  | None =>
    (* ❌ Assert instruction is not handled. *)
    assert false
  | Some previous_cycle =>
    let levels := Level_storage.levels_with_commitments_in_cycle c revealed in
    let combine
      (function_parameter :
      Tezos_raw_protocol_alpha.Storage.Seed.Nonce.context *
        Tezos_raw_protocol_alpha.Seed_repr.seed *
        list Tezos_raw_protocol_alpha__Storage.Seed.unrevealed_nonce)
      : Tezos_raw_protocol_alpha.Level_repr.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_raw_protocol_alpha.Raw_context.t *
            Tezos_raw_protocol_alpha.Seed_repr.seed *
            list Tezos_raw_protocol_alpha__Storage.Seed.unrevealed_nonce)) :=
      let '(c, random_seed, unrevealed) := function_parameter in
      fun level =>
        op_gtgteqquestion (Storage.Seed.Nonce.get c level)
          (fun function_parameter =>
            match function_parameter with
            | Tezos_raw_protocol_alpha__Storage.Seed.Revealed nonce =>
              op_gtgteqquestion (Storage.Seed.Nonce.delete c level)
                (fun c =>
                  __return (c, (Seed_repr.nonce random_seed nonce), unrevealed))
            | Tezos_raw_protocol_alpha__Storage.Seed.Unrevealed u =>
              op_gtgteqquestion (Storage.Seed.Nonce.delete c level)
                (fun c => __return (c, random_seed, (cons u unrevealed)))
            end) in
    op_gtgteqquestion (Storage.Seed.For_cycle.get c previous_cycle)
      (fun prev_seed =>
        let seed := Seed_repr.deterministic_seed prev_seed in
        op_gtgteqquestion (fold_left_s combine (c, seed, []) levels)
          (fun function_parameter =>
            let '(c, seed, unrevealed) := function_parameter in
            op_gtgteqquestion (Storage.Seed.For_cycle.init c cycle seed)
              (fun c => __return (c, unrevealed))))
  end.

Definition for_cycle
  (ctxt : Tezos_raw_protocol_alpha.Raw_context.context)
  (cycle : Tezos_raw_protocol_alpha.Cycle_repr.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Seed_repr.seed) :=
  let preserved := Constants_storage.preserved_cycles ctxt in
  let current_level := Level_storage.current ctxt in
  let current_cycle := Tezos_raw_protocol_alpha.Level_repr.t.cycle current_level
    in
  let latest :=
    if op_eq current_cycle root then
      Cycle_repr.add current_cycle (op_plus preserved 1)
    else
      Cycle_repr.add current_cycle preserved in
  let oldest :=
    match Cycle_repr.sub current_cycle preserved with
    | None => Cycle_repr.root
    | Some oldest => oldest
    end in
  op_gtgteqquestion
    (fail_unless (op_andand (op_lteq oldest cycle) (op_lteq cycle latest))
      (Tezos_protocol_environment_alpha__Environment.Error_monad.Unknown
        {| Unknown.oldest := oldest; Unknown.cycle := cycle;
          Unknown.latest := latest |}))
    (fun function_parameter =>
      let 'tt := function_parameter in
      Storage.Seed.For_cycle.get ctxt cycle).

Definition clear_cycle
  (c : Tezos_raw_protocol_alpha.Raw_context.t)
  (cycle : Tezos_raw_protocol_alpha.Cycle_repr.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  Storage.Seed.For_cycle.delete c cycle.

Definition init (ctxt : Tezos_raw_protocol_alpha.Raw_context.context)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  let preserved := Constants_storage.preserved_cycles ctxt in
  List.fold_left2
    (fun ctxt =>
      fun c =>
        fun seed =>
          op_gtgteqquestion ctxt
            (fun ctxt =>
              let cycle := Cycle_repr.of_int32_exn (Int32.of_int c) in
              Storage.Seed.For_cycle.init ctxt cycle seed)) (__return ctxt)
    (op_minusminusgt 0 (op_plus preserved 1))
    (Seed_repr.initial_seeds (op_plus preserved 2)).

Definition cycle_end
  (ctxt : Tezos_raw_protocol_alpha.Raw_context.context)
  (last_cycle : Tezos_raw_protocol_alpha.Cycle_repr.cycle)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Raw_context.context *
        list Tezos_raw_protocol_alpha__Storage.Seed.unrevealed_nonce)) :=
  let preserved := Constants_storage.preserved_cycles ctxt in
  op_gtgteqquestion
    match Cycle_repr.sub last_cycle preserved with
    | None => __return ctxt
    | Some cleared_cycle => clear_cycle ctxt cleared_cycle
    end
    (fun ctxt =>
      match Cycle_repr.pred last_cycle with
      | None => __return (ctxt, [])
      | Some revealed =>
        let inited_seed_cycle := Cycle_repr.add last_cycle (op_plus preserved 1)
          in
        compute_for_cycle ctxt revealed inited_seed_cycle
      end).

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

type error +=
  | Unknown of {
      oldest : Cycle_repr.t;
      cycle : Cycle_repr.t;
      latest : Cycle_repr.t;
    }

(* `Permanent *)

(** Generates the first [preserved_cycles+2] seeds for which
    there are no nonces. *)
val init : Raw_context.t -> Raw_context.t tzresult Lwt.t

val for_cycle : Raw_context.t -> Cycle_repr.t -> Seed_repr.seed tzresult Lwt.t

(** If it is the end of the cycle, computes and stores the seed of cycle at
    distance [preserved_cycle+2] in the future using the seed of the previous
    cycle and the revelations of the current one.  *)
val cycle_end :
  Raw_context.t ->
  Cycle_repr.t ->
  (Raw_context.t * Nonce_storage.unrevealed list) tzresult Lwt.t

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

(* extensible_type Tezos_protocol_environment_alpha__Environment.Error_monad.error *)

Parameter init :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t).

Parameter for_cycle :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Cycle_repr.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Seed_repr.seed).

Parameter cycle_end :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Cycle_repr.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Raw_context.t *
        list Tezos_raw_protocol_alpha.Nonce_storage.unrevealed)).

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Alpha_context

type rpc_context = {
  block_hash : Block_hash.t;
  block_header : Block_header.shell_header;
  context : Alpha_context.t;
}

let rpc_init ({block_hash; block_header; context} : Updater.rpc_context) =
  let level = block_header.level in
  let timestamp = block_header.timestamp in
  let fitness = block_header.fitness in
  Alpha_context.prepare
    ~level
    ~predecessor_timestamp:timestamp
    ~timestamp
    ~fitness
    context
  >>=? fun context -> return {block_hash; block_header; context}

let rpc_services =
  ref (RPC_directory.empty : Updater.rpc_context RPC_directory.t)

let register0_fullctxt s f =
  rpc_services :=
    RPC_directory.register !rpc_services s (fun ctxt q i ->
        rpc_init ctxt >>=? fun ctxt -> f ctxt q i)

let opt_register0_fullctxt s f =
  rpc_services :=
    RPC_directory.opt_register !rpc_services s (fun ctxt q i ->
        rpc_init ctxt >>=? fun ctxt -> f ctxt q i)

let register0 s f = register0_fullctxt s (fun {context; _} -> f context)

let register0_noctxt s f =
  rpc_services := RPC_directory.register !rpc_services s (fun _ q i -> f q i)

let register1_fullctxt s f =
  rpc_services :=
    RPC_directory.register !rpc_services s (fun (ctxt, arg) q i ->
        rpc_init ctxt >>=? fun ctxt -> f ctxt arg q i)

let register1 s f = register1_fullctxt s (fun {context; _} x -> f context x)

let register1_noctxt s f =
  rpc_services :=
    RPC_directory.register !rpc_services s (fun (_, arg) q i -> f arg q i)

let register2_fullctxt s f =
  rpc_services :=
    RPC_directory.register !rpc_services s (fun ((ctxt, arg1), arg2) q i ->
        rpc_init ctxt >>=? fun ctxt -> f ctxt arg1 arg2 q i)

let register2 s f =
  register2_fullctxt s (fun {context; _} a1 a2 q i -> f context a1 a2 q i)

let get_rpc_services () =
  let p =
    RPC_directory.map
      (fun c ->
        rpc_init c
        >>= function Error _ -> assert false | Ok c -> Lwt.return c.context)
      (Storage_description.build_directory Alpha_context.description)
  in
  RPC_directory.register_dynamic_directory
    !rpc_services
    RPC_path.(open_root / "context" / "raw" / "json")
    (fun _ -> Lwt.return p)

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Import Alpha_context.

Module rpc_context.
  Record record := {
    block_hash : Tezos_protocol_environment_alpha__Environment.Block_hash.t;
    block_header :
      Tezos_raw_protocol_alpha.Alpha_context.Block_header.shell_header;
    context : Tezos_raw_protocol_alpha.Alpha_context.t }.
End rpc_context.
Definition rpc_context := rpc_context.record.

Definition rpc_init
  (function_parameter :
    Tezos_protocol_environment_alpha__Environment.Updater.rpc_context)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      rpc_context) :=
  let '{|
    Tezos_protocol_environment_alpha__Environment.Updater.rpc_context.block_hash
      := block_hash;
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context.block_header
        := block_header;
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context.context
        := context
      |} := function_parameter in
  let level :=
    Tezos_protocol_environment_alpha__Environment.Block_header.shell_header.level
      block_header in
  let timestamp :=
    Tezos_protocol_environment_alpha__Environment.Block_header.shell_header.timestamp
      block_header in
  let fitness :=
    Tezos_protocol_environment_alpha__Environment.Block_header.shell_header.fitness
      block_header in
  op_gtgteqquestion
    (Alpha_context.prepare context level timestamp timestamp fitness)
    (fun context =>
      __return
        {| rpc_context.block_hash := block_hash;
          rpc_context.block_header := block_header;
          rpc_context.context := context |}).

Definition rpc_services
  : Tezos_protocol_environment_alpha__Environment.Pervasives.ref
    (Tezos_protocol_environment_alpha__Environment.RPC_directory.t
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context) :=
  __ref_value RPC_directory.empty.

Definition register0_fullctxt {A B C : Set}
  (s :
    Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
        (* `POST *) unit + (* `PUT *) unit)
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context A B C)
  (f :
    rpc_context -> A -> B ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult C))
  : unit :=
  op_coloneq rpc_services
    (RPC_directory.register (op_exclamation rpc_services) s
      (fun ctxt =>
        fun q =>
          fun i => op_gtgteqquestion (rpc_init ctxt) (fun ctxt => f ctxt q i))).

Definition opt_register0_fullctxt {A B C : Set}
  (s :
    Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
        (* `POST *) unit + (* `PUT *) unit)
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context A B C)
  (f :
    rpc_context -> A -> B ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (option C))) : unit :=
  op_coloneq rpc_services
    (RPC_directory.opt_register (op_exclamation rpc_services) s
      (fun ctxt =>
        fun q =>
          fun i => op_gtgteqquestion (rpc_init ctxt) (fun ctxt => f ctxt q i))).

Definition register0 {A B C : Set}
  (s :
    Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
        (* `POST *) unit + (* `PUT *) unit)
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context A B C)
  (f :
    Tezos_raw_protocol_alpha.Alpha_context.t -> A -> B ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult C))
  : unit :=
  register0_fullctxt s
    (fun function_parameter =>
      let '{| rpc_context.context := context |} := function_parameter in
      f context).

Definition register0_noctxt {A B C D : Set}
  (s :
    Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
        (* `POST *) unit + (* `PUT *) unit)
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context A B C D)
  (f :
    B -> C ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult D))
  : unit :=
  op_coloneq rpc_services
    (RPC_directory.register (op_exclamation rpc_services) s
      (fun function_parameter =>
        let '_ := function_parameter in
        fun q => fun i => f q i)).

Definition register1_fullctxt {A B C D : Set}
  (s :
    Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
        (* `POST *) unit + (* `PUT *) unit)
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
      (Tezos_protocol_environment_alpha__Environment.Updater.rpc_context * A) B
      C D)
  (f :
    rpc_context -> A -> B -> C ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult D))
  : unit :=
  op_coloneq rpc_services
    (RPC_directory.register (op_exclamation rpc_services) s
      (fun function_parameter =>
        let '(ctxt, arg) := function_parameter in
        fun q =>
          fun i =>
            op_gtgteqquestion (rpc_init ctxt) (fun ctxt => f ctxt arg q i))).

Definition register1 {A B C D : Set}
  (s :
    Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
        (* `POST *) unit + (* `PUT *) unit)
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
      (Tezos_protocol_environment_alpha__Environment.Updater.rpc_context * A) B
      C D)
  (f :
    Tezos_raw_protocol_alpha.Alpha_context.t -> A -> B -> C ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult D))
  : unit :=
  register1_fullctxt s
    (fun function_parameter =>
      let '{| rpc_context.context := context |} := function_parameter in
      fun x => f context x).

Definition register1_noctxt {A B C D E : Set}
  (s :
    Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
        (* `POST *) unit + (* `PUT *) unit)
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context (A * B)
      C D E)
  (f :
    B -> C -> D ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult E))
  : unit :=
  op_coloneq rpc_services
    (RPC_directory.register (op_exclamation rpc_services) s
      (fun function_parameter =>
        let '(_, arg) := function_parameter in
        fun q => fun i => f arg q i)).

Definition register2_fullctxt {A B C D E : Set}
  (s :
    Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
        (* `POST *) unit + (* `PUT *) unit)
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
      ((Tezos_protocol_environment_alpha__Environment.Updater.rpc_context * A) *
        B) C D E)
  (f :
    rpc_context -> A -> B -> C -> D ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult E))
  : unit :=
  op_coloneq rpc_services
    (RPC_directory.register (op_exclamation rpc_services) s
      (fun function_parameter =>
        let '((ctxt, arg1), arg2) := function_parameter in
        fun q =>
          fun i =>
            op_gtgteqquestion (rpc_init ctxt) (fun ctxt => f ctxt arg1 arg2 q i))).

Definition register2 {A B C D E : Set}
  (s :
    Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
        (* `POST *) unit + (* `PUT *) unit)
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
      ((Tezos_protocol_environment_alpha__Environment.Updater.rpc_context * A) *
        B) C D E)
  (f :
    Tezos_raw_protocol_alpha.Alpha_context.t -> A -> B -> C -> D ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult E))
  : unit :=
  register2_fullctxt s
    (fun function_parameter =>
      let '{| rpc_context.context := context |} := function_parameter in
      fun a1 => fun a2 => fun q => fun i => f context a1 a2 q i).

Definition get_rpc_services (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.RPC_directory.directory
    Tezos_protocol_environment_alpha__Environment.Updater.rpc_context :=
  let 'tt := function_parameter in
  let p :=
    RPC_directory.map
      (fun c =>
        op_gtgteq (rpc_init c)
          (fun function_parameter =>
            match function_parameter with
            | Tezos_protocol_environment_alpha__Environment.Pervasives.Error _
              =>
              (* ❌ Assert instruction is not handled. *)
              assert false
            | Tezos_protocol_environment_alpha__Environment.Pervasives.Ok c =>
              Lwt.__return (rpc_context.context c)
            end))
      (Storage_description.build_directory Alpha_context.description) in
  RPC_directory.register_dynamic_directory None (op_exclamation rpc_services)
    (op_div (op_div (op_div open_root "context" % string) "raw" % string)
      "json" % string)
    (fun function_parameter =>
      let '_ := function_parameter in
      Lwt.__return p).

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Storage_functors

module Int = struct
  type t = int

  let encoding = Data_encoding.uint16
end

module Int32 = struct
  type t = Int32.t

  let encoding = Data_encoding.int32
end

module Z = struct
  include Z

  let encoding = Data_encoding.z
end

module Int_index = struct
  type t = int

  let path_length = 1

  let to_path c l = string_of_int c :: l

  let of_path = function
    | [] | _ :: _ :: _ ->
        None
    | [c] ->
        int_of_string_opt c

  type 'a ipath = 'a * t

  let args =
    Storage_description.One
      {
        rpc_arg = RPC_arg.int;
        encoding = Data_encoding.int31;
        compare = Compare.Int.compare;
      }
end

module Make_index (H : Storage_description.INDEX) :
  INDEX with type t = H.t and type 'a ipath = 'a * H.t = struct
  include H

  type 'a ipath = 'a * t

  let args = Storage_description.One {rpc_arg; encoding; compare}
end

module Block_priority =
  Make_single_data_storage (Registered) (Raw_context)
    (struct
      let name = ["block_priority"]
    end)
    (Int)

(** Contracts handling *)

module Contract = struct
  module Raw_context =
    Make_subcontext (Registered) (Raw_context)
      (struct
        let name = ["contracts"]
      end)

  module Global_counter =
    Make_single_data_storage (Registered) (Raw_context)
      (struct
        let name = ["global_counter"]
      end)
      (Z)

  module Indexed_context =
    Make_indexed_subcontext
      (Make_subcontext (Registered) (Raw_context)
         (struct
           let name = ["index"]
         end))
         (Make_index (Contract_repr.Index))

  let fold = Indexed_context.fold_keys

  let list = Indexed_context.keys

  module Balance =
    Indexed_context.Make_map
      (struct
        let name = ["balance"]
      end)
      (Tez_repr)

  module Frozen_balance_index =
    Make_indexed_subcontext
      (Make_subcontext (Registered) (Indexed_context.Raw_context)
         (struct
           let name = ["frozen_balance"]
         end))
         (Make_index (Cycle_repr.Index))

  module Frozen_deposits =
    Frozen_balance_index.Make_map
      (struct
        let name = ["deposits"]
      end)
      (Tez_repr)

  module Frozen_fees =
    Frozen_balance_index.Make_map
      (struct
        let name = ["fees"]
      end)
      (Tez_repr)

  module Frozen_rewards =
    Frozen_balance_index.Make_map
      (struct
        let name = ["rewards"]
      end)
      (Tez_repr)

  module Manager =
    Indexed_context.Make_map
      (struct
        let name = ["manager"]
      end)
      (Manager_repr)

  module Delegate =
    Indexed_context.Make_map
      (struct
        let name = ["delegate"]
      end)
      (Signature.Public_key_hash)

  module Inactive_delegate =
    Indexed_context.Make_set
      (Registered)
      (struct
        let name = ["inactive_delegate"]
      end)

  module Delegate_desactivation =
    Indexed_context.Make_map
      (struct
        let name = ["delegate_desactivation"]
      end)
      (Cycle_repr)

  module Delegated =
    Make_data_set_storage
      (Make_subcontext (Registered) (Indexed_context.Raw_context)
         (struct
           let name = ["delegated"]
         end))
         (Make_index (Contract_repr.Index))

  module Counter =
    Indexed_context.Make_map
      (struct
        let name = ["counter"]
      end)
      (Z)

  (* Consume gas for serilization and deserialization of expr in this
     module *)
  module Make_carbonated_map_expr (N : Storage_sigs.NAME) = struct
    module I =
      Indexed_context.Make_carbonated_map
        (N)
        (struct
          type t = Script_repr.lazy_expr

          let encoding = Script_repr.lazy_expr_encoding
        end)

    type context = I.context

    type key = I.key

    type value = I.value

    let mem = I.mem

    let delete = I.delete

    let remove = I.remove

    let consume_deserialize_gas ctxt value =
      Lwt.return
      @@ ( Raw_context.check_enough_gas
             ctxt
             (Script_repr.minimal_deserialize_cost value)
         >>? fun () ->
         Script_repr.force_decode value
         >>? fun (_value, value_cost) ->
         Raw_context.consume_gas ctxt value_cost )

    let consume_serialize_gas ctxt value =
      Lwt.return
      @@ ( Script_repr.force_bytes value
         >>? fun (_value, value_cost) ->
         Raw_context.consume_gas ctxt value_cost )

    let get ctxt contract =
      I.get ctxt contract
      >>=? fun (ctxt, value) ->
      consume_deserialize_gas ctxt value >>|? fun ctxt -> (ctxt, value)

    let get_option ctxt contract =
      I.get_option ctxt contract
      >>=? fun (ctxt, value_opt) ->
      match value_opt with
      | None ->
          return (ctxt, None)
      | Some value ->
          consume_deserialize_gas ctxt value >>|? fun ctxt -> (ctxt, value_opt)

    let set ctxt contract value =
      consume_serialize_gas ctxt value
      >>=? fun ctxt -> I.set ctxt contract value

    let set_option ctxt contract value_opt =
      match value_opt with
      | None ->
          I.set_option ctxt contract None
      | Some value ->
          consume_serialize_gas ctxt value
          >>=? fun ctxt -> I.set_option ctxt contract value_opt

    let init ctxt contract value =
      consume_serialize_gas ctxt value
      >>=? fun ctxt -> I.init ctxt contract value

    let init_set ctxt contract value =
      consume_serialize_gas ctxt value
      >>=? fun ctxt -> I.init_set ctxt contract value
  end

  module Code = Make_carbonated_map_expr (struct
    let name = ["code"]
  end)

  module Storage = Make_carbonated_map_expr (struct
    let name = ["storage"]
  end)

  module Paid_storage_space =
    Indexed_context.Make_map
      (struct
        let name = ["paid_bytes"]
      end)
      (Z)

  module Used_storage_space =
    Indexed_context.Make_map
      (struct
        let name = ["used_bytes"]
      end)
      (Z)

  module Roll_list =
    Indexed_context.Make_map
      (struct
        let name = ["roll_list"]
      end)
      (Roll_repr)

  module Change =
    Indexed_context.Make_map
      (struct
        let name = ["change"]
      end)
      (Tez_repr)
end

(** Big maps handling *)

module Big_map = struct
  module Raw_context =
    Make_subcontext (Registered) (Raw_context)
      (struct
        let name = ["big_maps"]
      end)

  module Next = struct
    include Make_single_data_storage (Registered) (Raw_context)
              (struct
                let name = ["next"]
              end)
              (Z)

    let incr ctxt =
      get ctxt
      >>=? fun i -> set ctxt (Z.succ i) >>=? fun ctxt -> return (ctxt, i)

    let init ctxt = init ctxt Z.zero
  end

  module Index = struct
    type t = Z.t

    let rpc_arg =
      let construct = Z.to_string in
      let destruct hash =
        match Z.of_string hash with
        | exception _ ->
            Error "Cannot parse big map id"
        | id ->
            Ok id
      in
      RPC_arg.make
        ~descr:"A big map identifier"
        ~name:"big_map_id"
        ~construct
        ~destruct
        ()

    let encoding =
      Data_encoding.def
        "big_map_id"
        ~title:"Big map identifier"
        ~description:"A big map identifier"
        Z.encoding

    let compare = Compare.Z.compare

    let path_length = 7

    let to_path c l =
      let raw_key = Data_encoding.Binary.to_bytes_exn encoding c in
      let (`Hex index_key) = MBytes.to_hex (Raw_hashes.blake2b raw_key) in
      String.sub index_key 0 2 :: String.sub index_key 2 2
      :: String.sub index_key 4 2 :: String.sub index_key 6 2
      :: String.sub index_key 8 2 :: String.sub index_key 10 2 :: Z.to_string c
      :: l

    let of_path = function
      | []
      | [_]
      | [_; _]
      | [_; _; _]
      | [_; _; _; _]
      | [_; _; _; _; _]
      | [_; _; _; _; _; _]
      | _ :: _ :: _ :: _ :: _ :: _ :: _ :: _ :: _ ->
          None
      | [index1; index2; index3; index4; index5; index6; key] ->
          let c = Z.of_string key in
          let raw_key = Data_encoding.Binary.to_bytes_exn encoding c in
          let (`Hex index_key) = MBytes.to_hex (Raw_hashes.blake2b raw_key) in
          assert (Compare.String.(String.sub index_key 0 2 = index1)) ;
          assert (Compare.String.(String.sub index_key 2 2 = index2)) ;
          assert (Compare.String.(String.sub index_key 4 2 = index3)) ;
          assert (Compare.String.(String.sub index_key 6 2 = index4)) ;
          assert (Compare.String.(String.sub index_key 8 2 = index5)) ;
          assert (Compare.String.(String.sub index_key 10 2 = index6)) ;
          Some c
  end

  module Indexed_context =
    Make_indexed_subcontext
      (Make_subcontext (Registered) (Raw_context)
         (struct
           let name = ["index"]
         end))
         (Make_index (Index))

  let rpc_arg = Index.rpc_arg

  let fold = Indexed_context.fold_keys

  let list = Indexed_context.keys

  let remove_rec ctxt n = Indexed_context.remove_rec ctxt n

  let copy ctxt ~from ~to_ = Indexed_context.copy ctxt ~from ~to_

  type key = Raw_context.t * Z.t

  module Total_bytes =
    Indexed_context.Make_map
      (struct
        let name = ["total_bytes"]
      end)
      (Z)

  module Key_type =
    Indexed_context.Make_map
      (struct
        let name = ["key_type"]
      end)
      (struct
        type t = Script_repr.expr

        let encoding = Script_repr.expr_encoding
      end)

  module Value_type =
    Indexed_context.Make_map
      (struct
        let name = ["value_type"]
      end)
      (struct
        type t = Script_repr.expr

        let encoding = Script_repr.expr_encoding
      end)

  module Contents = struct
    module I =
      Storage_functors.Make_indexed_carbonated_data_storage
        (Make_subcontext (Registered) (Indexed_context.Raw_context)
           (struct
             let name = ["contents"]
           end))
           (Make_index (Script_expr_hash))
           (struct
             type t = Script_repr.expr

             let encoding = Script_repr.expr_encoding
           end)

    type context = I.context

    type key = I.key

    type value = I.value

    let mem = I.mem

    let delete = I.delete

    let remove = I.remove

    let set = I.set

    let set_option = I.set_option

    let init = I.init

    let init_set = I.init_set

    let consume_deserialize_gas ctxt value =
      Lwt.return
      @@ Raw_context.consume_gas ctxt (Script_repr.deserialized_cost value)

    let get ctxt contract =
      I.get ctxt contract
      >>=? fun (ctxt, value) ->
      consume_deserialize_gas ctxt value >>|? fun ctxt -> (ctxt, value)

    let get_option ctxt contract =
      I.get_option ctxt contract
      >>=? fun (ctxt, value_opt) ->
      match value_opt with
      | None ->
          return (ctxt, None)
      | Some value ->
          consume_deserialize_gas ctxt value >>|? fun ctxt -> (ctxt, value_opt)
  end
end

module Delegates =
  Make_data_set_storage
    (Make_subcontext (Registered) (Raw_context)
       (struct
         let name = ["delegates"]
       end))
       (Make_index (Signature.Public_key_hash))

module Active_delegates_with_rolls =
  Make_data_set_storage
    (Make_subcontext (Registered) (Raw_context)
       (struct
         let name = ["active_delegates_with_rolls"]
       end))
       (Make_index (Signature.Public_key_hash))

module Delegates_with_frozen_balance_index =
  Make_indexed_subcontext
    (Make_subcontext (Registered) (Raw_context)
       (struct
         let name = ["delegates_with_frozen_balance"]
       end))
       (Make_index (Cycle_repr.Index))

module Delegates_with_frozen_balance =
  Make_data_set_storage
    (Delegates_with_frozen_balance_index.Raw_context)
    (Make_index (Signature.Public_key_hash))

(** Rolls *)

module Cycle = struct
  module Indexed_context =
    Make_indexed_subcontext
      (Make_subcontext (Registered) (Raw_context)
         (struct
           let name = ["cycle"]
         end))
         (Make_index (Cycle_repr.Index))

  module Last_roll =
    Make_indexed_data_storage
      (Make_subcontext (Registered) (Indexed_context.Raw_context)
         (struct
           let name = ["last_roll"]
         end))
         (Int_index)
      (Roll_repr)

  module Roll_snapshot =
    Indexed_context.Make_map
      (struct
        let name = ["roll_snapshot"]
      end)
      (Int)

  type unrevealed_nonce = {
    nonce_hash : Nonce_hash.t;
    delegate : Signature.Public_key_hash.t;
    rewards : Tez_repr.t;
    fees : Tez_repr.t;
  }

  type nonce_status =
    | Unrevealed of unrevealed_nonce
    | Revealed of Seed_repr.nonce

  let nonce_status_encoding =
    let open Data_encoding in
    union
      [ case
          (Tag 0)
          ~title:"Unrevealed"
          (tup4
             Nonce_hash.encoding
             Signature.Public_key_hash.encoding
             Tez_repr.encoding
             Tez_repr.encoding)
          (function
            | Unrevealed {nonce_hash; delegate; rewards; fees} ->
                Some (nonce_hash, delegate, rewards, fees)
            | _ ->
                None)
          (fun (nonce_hash, delegate, rewards, fees) ->
            Unrevealed {nonce_hash; delegate; rewards; fees});
        case
          (Tag 1)
          ~title:"Revealed"
          Seed_repr.nonce_encoding
          (function Revealed nonce -> Some nonce | _ -> None)
          (fun nonce -> Revealed nonce) ]

  module Nonce =
    Make_indexed_data_storage
      (Make_subcontext (Registered) (Indexed_context.Raw_context)
         (struct
           let name = ["nonces"]
         end))
         (Make_index (Raw_level_repr.Index))
         (struct
           type t = nonce_status

           let encoding = nonce_status_encoding
         end)

  module Seed =
    Indexed_context.Make_map
      (struct
        let name = ["random_seed"]
      end)
      (struct
        type t = Seed_repr.seed

        let encoding = Seed_repr.seed_encoding
      end)
end

module Roll = struct
  module Raw_context =
    Make_subcontext (Registered) (Raw_context)
      (struct
        let name = ["rolls"]
      end)

  module Indexed_context =
    Make_indexed_subcontext
      (Make_subcontext (Registered) (Raw_context)
         (struct
           let name = ["index"]
         end))
         (Make_index (Roll_repr.Index))

  module Next =
    Make_single_data_storage (Registered) (Raw_context)
      (struct
        let name = ["next"]
      end)
      (Roll_repr)

  module Limbo =
    Make_single_data_storage (Registered) (Raw_context)
      (struct
        let name = ["limbo"]
      end)
      (Roll_repr)

  module Delegate_roll_list =
    Wrap_indexed_data_storage
      (Contract.Roll_list)
      (struct
        type t = Signature.Public_key_hash.t

        let wrap = Contract_repr.implicit_contract

        let unwrap = Contract_repr.is_implicit
      end)

  module Successor =
    Indexed_context.Make_map
      (struct
        let name = ["successor"]
      end)
      (Roll_repr)

  module Delegate_change =
    Wrap_indexed_data_storage
      (Contract.Change)
      (struct
        type t = Signature.Public_key_hash.t

        let wrap = Contract_repr.implicit_contract

        let unwrap = Contract_repr.is_implicit
      end)

  module Snapshoted_owner_index = struct
    type t = Cycle_repr.t * int

    let path_length = Cycle_repr.Index.path_length + 1

    let to_path (c, n) s = Cycle_repr.Index.to_path c (string_of_int n :: s)

    let of_path l =
      match Misc.take Cycle_repr.Index.path_length l with
      | None | Some (_, ([] | _ :: _ :: _)) ->
          None
      | Some (l1, [l2]) -> (
        match (Cycle_repr.Index.of_path l1, int_of_string_opt l2) with
        | (None, _) | (_, None) ->
            None
        | (Some c, Some i) ->
            Some (c, i) )

    type 'a ipath = ('a * Cycle_repr.t) * int

    let left_args =
      Storage_description.One
        {
          rpc_arg = Cycle_repr.rpc_arg;
          encoding = Cycle_repr.encoding;
          compare = Cycle_repr.compare;
        }

    let right_args =
      Storage_description.One
        {
          rpc_arg = RPC_arg.int;
          encoding = Data_encoding.int31;
          compare = Compare.Int.compare;
        }

    let args = Storage_description.(Pair (left_args, right_args))
  end

  module Owner =
    Make_indexed_data_snapshotable_storage
      (Make_subcontext (Registered) (Raw_context)
         (struct
           let name = ["owner"]
         end))
         (Snapshoted_owner_index)
      (Make_index (Roll_repr.Index))
      (Signature.Public_key)

  module Snapshot_for_cycle = Cycle.Roll_snapshot
  module Last_for_snapshot = Cycle.Last_roll

  let clear = Indexed_context.clear
end

(** Votes *)

module Vote = struct
  module Raw_context =
    Make_subcontext (Registered) (Raw_context)
      (struct
        let name = ["votes"]
      end)

  module Current_period_kind =
    Make_single_data_storage (Registered) (Raw_context)
      (struct
        let name = ["current_period_kind"]
      end)
      (struct
        type t = Voting_period_repr.kind

        let encoding = Voting_period_repr.kind_encoding
      end)

  module Participation_ema =
    Make_single_data_storage (Registered) (Raw_context)
      (struct
        let name = ["participation_ema"]
      end)
      (Int32)

  module Current_proposal =
    Make_single_data_storage (Registered) (Raw_context)
      (struct
        let name = ["current_proposal"]
      end)
      (Protocol_hash)

  module Listings_size =
    Make_single_data_storage (Registered) (Raw_context)
      (struct
        let name = ["listings_size"]
      end)
      (Int32)

  module Listings =
    Make_indexed_data_storage
      (Make_subcontext (Registered) (Raw_context)
         (struct
           let name = ["listings"]
         end))
         (Make_index (Signature.Public_key_hash))
         (Int32)

  module Proposals =
    Make_data_set_storage
      (Make_subcontext (Registered) (Raw_context)
         (struct
           let name = ["proposals"]
         end))
         (Pair
            (Make_index
               (Protocol_hash))
               (Make_index (Signature.Public_key_hash)))

  module Proposals_count =
    Make_indexed_data_storage
      (Make_subcontext (Registered) (Raw_context)
         (struct
           let name = ["proposals_count"]
         end))
         (Make_index (Signature.Public_key_hash))
         (Int)

  module Ballots =
    Make_indexed_data_storage
      (Make_subcontext (Registered) (Raw_context)
         (struct
           let name = ["ballots"]
         end))
         (Make_index (Signature.Public_key_hash))
         (struct
           type t = Vote_repr.ballot

           let encoding = Vote_repr.ballot_encoding
         end)
end

(** Seed *)

module Seed = struct
  type unrevealed_nonce = Cycle.unrevealed_nonce = {
    nonce_hash : Nonce_hash.t;
    delegate : Signature.Public_key_hash.t;
    rewards : Tez_repr.t;
    fees : Tez_repr.t;
  }

  type nonce_status = Cycle.nonce_status =
    | Unrevealed of unrevealed_nonce
    | Revealed of Seed_repr.nonce

  module Nonce = struct
    open Level_repr

    type context = Raw_context.t

    let mem ctxt l = Cycle.Nonce.mem (ctxt, l.cycle) l.level

    let get ctxt l = Cycle.Nonce.get (ctxt, l.cycle) l.level

    let get_option ctxt l = Cycle.Nonce.get_option (ctxt, l.cycle) l.level

    let set ctxt l v = Cycle.Nonce.set (ctxt, l.cycle) l.level v

    let init ctxt l v = Cycle.Nonce.init (ctxt, l.cycle) l.level v

    let init_set ctxt l v = Cycle.Nonce.init_set (ctxt, l.cycle) l.level v

    let set_option ctxt l v = Cycle.Nonce.set_option (ctxt, l.cycle) l.level v

    let delete ctxt l = Cycle.Nonce.delete (ctxt, l.cycle) l.level

    let remove ctxt l = Cycle.Nonce.remove (ctxt, l.cycle) l.level
  end

  module For_cycle = Cycle.Seed
end

(** Commitments *)

module Commitments =
  Make_indexed_data_storage
    (Make_subcontext (Registered) (Raw_context)
       (struct
         let name = ["commitments"]
       end))
       (Make_index (Blinded_public_key_hash.Index))
       (Tez_repr)

(** Ramp up security deposits... *)

module Ramp_up = struct
  module Rewards =
    Make_indexed_data_storage
      (Make_subcontext (Registered) (Raw_context)
         (struct
           let name = ["ramp_up"; "rewards"]
         end))
         (Make_index (Cycle_repr.Index))
         (struct
           type t = Tez_repr.t * Tez_repr.t

           let encoding =
             Data_encoding.tup2 Tez_repr.encoding Tez_repr.encoding
         end)

  module Security_deposits =
    Make_indexed_data_storage
      (Make_subcontext (Registered) (Raw_context)
         (struct
           let name = ["ramp_up"; "deposits"]
         end))
         (Make_index (Cycle_repr.Index))
         (struct
           type t = Tez_repr.t * Tez_repr.t

           let encoding =
             Data_encoding.tup2 Tez_repr.encoding Tez_repr.encoding
         end)
end

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Import Storage_functors.

Module Int.
  Definition t := Z.
  
  Definition encoding
    : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding Z :=
    Data_encoding.uint16.
End Int.

Module Int32.
  Definition t := Tezos_protocol_environment_alpha__Environment.Int32.t.
  
  Definition encoding
    : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding int32 :=
    Data_encoding.__int32_value.
End Int32.

Module Z.
  Export Z.
  
  Definition encoding
    : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
      Tezos_protocol_environment_alpha__Environment.Z.t := Data_encoding.z.
End Z.

Module Int_index.
  Definition t := Z.
  
  Definition path_length : Z := 1.
  
  Definition to_path (c : Z) (l : list string) : list string :=
    cons (string_of_int c) l.
  
  Definition of_path (function_parameter : list string) : option Z :=
    match function_parameter with
    | [] | cons _ (cons _ _) => None
    | cons c [] => int_of_string_opt c
    end.
  
  Definition ipath (a : Set) := a * t.
  
  Definition args {A : Set}
    : Tezos_raw_protocol_alpha.Storage_description.args A
      Tezos_protocol_environment_alpha__Environment.Compare.Int.t
      (A * Tezos_protocol_environment_alpha__Environment.Compare.Int.t) :=
    Tezos_raw_protocol_alpha.Storage_description.One
      {|
        Tezos_raw_protocol_alpha.Storage_description.args.One.rpc_arg :=
          RPC_arg.int;
        Tezos_raw_protocol_alpha.Storage_description.args.One.encoding :=
          Data_encoding.int31;
        Tezos_raw_protocol_alpha.Storage_description.args.One.compare :=
          Compare.Int.compare |}.
End Int_index.

(* ❌ Functors are not handled. *)
functor

(* ❌ Applications of functors are not handled. *)
functor_application

Module Contract.
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  Definition fold {A : Set}
    : Indexed_context.context -> A ->
    (Indexed_context.key -> A ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t A) ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t A :=
    Indexed_context.fold_keys.
  
  Definition __list_value
    : Indexed_context.context ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (list Indexed_context.key) := Indexed_context.keys.
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  (* ❌ Functors are not handled. *)
  functor
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
End Contract.

Module Big_map.
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  Module Next.
    (* ❌ Cannot include this kind of module expression *)
    include
    
    Definition incr (ctxt : context)
      : Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_raw_protocol_alpha.Raw_context.t * value)) :=
      op_gtgteqquestion (get ctxt)
        (fun i =>
          op_gtgteqquestion (set ctxt (Z.succ i))
            (fun ctxt => __return (ctxt, i))).
    
    Definition init (ctxt : context)
      : Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t) := init ctxt Z.zero.
  End Next.
  
  Module Index.
    Definition t := Z.t.
    
    Definition rpc_arg
      : Tezos_protocol_environment_alpha__Environment.RPC_arg.arg Z.t :=
      let construct := Z.to_string in
      let destruct (__hash_value : string)
        : Tezos_protocol_environment_alpha__Environment.Pervasives.result Z.t
          string :=
        let 'id := Z.of_string __hash_value in
        Tezos_protocol_environment_alpha__Environment.Pervasives.Ok id in
      RPC_arg.make (Some "A big map identifier" % string) "big_map_id" % string
        destruct construct tt.
    
    Definition encoding
      : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
        Tezos_protocol_environment_alpha__Environment.Z.t :=
      Data_encoding.def "big_map_id" % string
        (Some "Big map identifier" % string)
        (Some "A big map identifier" % string) Z.encoding.
    
    Definition compare
      : Tezos_protocol_environment_alpha__Environment.Compare.Z.t ->
      Tezos_protocol_environment_alpha__Environment.Compare.Z.t -> Z :=
      Compare.Z.compare.
    
    Definition path_length : Z := 7.
    
    Definition to_path
      (c : Tezos_protocol_environment_alpha__Environment.Z.t) (l : list string)
      : list string :=
      let raw_key := Data_encoding.Binary.to_bytes_exn encoding c in
      let 'Hex index_key := MBytes.to_hex (Raw_hashes.blake2b raw_key) in
      cons (String.sub index_key 0 2)
        (cons (String.sub index_key 2 2)
          (cons (String.sub index_key 4 2)
            (cons (String.sub index_key 6 2)
              (cons (String.sub index_key 8 2)
                (cons (String.sub index_key 10 2) (cons (Z.to_string c) l)))))).
    
    Definition of_path
      (function_parameter :
        list Tezos_protocol_environment_alpha__Environment.Compare.String.t)
      : option Z.t :=
      match function_parameter with
      |
        [] | cons _ [] | cons _ (cons _ []) | cons _ (cons _ (cons _ [])) |
          cons _ (cons _ (cons _ (cons _ []))) |
          cons _ (cons _ (cons _ (cons _ (cons _ [])))) |
          cons _ (cons _ (cons _ (cons _ (cons _ (cons _ []))))) |
          cons _
            (cons _ (cons _ (cons _ (cons _ (cons _ (cons _ (cons _ _))))))) =>
        None
      |
        cons index1
          (cons index2
            (cons index3 (cons index4 (cons index5 (cons index6 (cons key []))))))
        =>
        let c := Z.of_string key in
        let raw_key := Data_encoding.Binary.to_bytes_exn encoding c in
        let 'Hex index_key := MBytes.to_hex (Raw_hashes.blake2b raw_key) in
        (* ❌ Sequences of instructions are not handled (operator ";") *)
        let _ :=
          (* ❌ Assert instruction is not handled. *)
          assert (op_eq (String.sub index_key 0 2) index1) in
        (* ❌ Sequences of instructions are not handled (operator ";") *)
        let _ :=
          (* ❌ Assert instruction is not handled. *)
          assert (op_eq (String.sub index_key 2 2) index2) in
        (* ❌ Sequences of instructions are not handled (operator ";") *)
        let _ :=
          (* ❌ Assert instruction is not handled. *)
          assert (op_eq (String.sub index_key 4 2) index3) in
        (* ❌ Sequences of instructions are not handled (operator ";") *)
        let _ :=
          (* ❌ Assert instruction is not handled. *)
          assert (op_eq (String.sub index_key 6 2) index4) in
        (* ❌ Sequences of instructions are not handled (operator ";") *)
        let _ :=
          (* ❌ Assert instruction is not handled. *)
          assert (op_eq (String.sub index_key 8 2) index5) in
        (* ❌ Sequences of instructions are not handled (operator ";") *)
        let _ :=
          (* ❌ Assert instruction is not handled. *)
          assert (op_eq (String.sub index_key 10 2) index6) in
        Some c
      end.
  End Index.
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  Definition rpc_arg
    : Tezos_protocol_environment_alpha__Environment.RPC_arg.arg Z.t :=
    Index.rpc_arg.
  
  Definition fold {A : Set}
    : Indexed_context.context -> A ->
    (Indexed_context.key -> A ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t A) ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t A :=
    Indexed_context.fold_keys.
  
  Definition __list_value
    : Indexed_context.context ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (list Indexed_context.key) := Indexed_context.keys.
  
  Definition remove_rec
    (ctxt : Indexed_context.context) (n : Indexed_context.key)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      Indexed_context.context := Indexed_context.remove_rec ctxt n.
  
  Definition copy
    (ctxt : Indexed_context.context) (from : Indexed_context.key)
    (to_ : Indexed_context.key)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        Indexed_context.context) := Indexed_context.copy ctxt from to_.
  
  Definition key := Raw_context.t * Z.t.
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  Module Contents.
    (* ❌ Applications of functors are not handled. *)
    functor_application
    
    Definition context := I.context.
    
    Definition key := I.key.
    
    Definition value := I.value.
    
    Definition mem
      : I.context -> I.key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_raw_protocol_alpha.Raw_context.t * bool)) := I.mem.
    
    Definition delete
      : I.context -> I.key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_raw_protocol_alpha.Raw_context.t * Z)) := I.delete.
    
    Definition remove
      : I.context -> I.key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_raw_protocol_alpha.Raw_context.t * Z * bool)) := I.remove.
    
    Definition set
      : I.context -> I.key -> I.value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_raw_protocol_alpha.Raw_context.t * Z)) := I.set.
    
    Definition set_option
      : I.context -> I.key -> option I.value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_raw_protocol_alpha.Raw_context.t * Z * bool)) := I.set_option.
    
    Definition init
      : I.context -> I.key -> I.value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_raw_protocol_alpha.Raw_context.t * Z)) := I.init.
    
    Definition init_set
      : I.context -> I.key -> I.value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_raw_protocol_alpha.Raw_context.t * Z * bool)) := I.init_set.
    
    Definition consume_deserialize_gas
      (ctxt : Raw_context.context)
      (value : Tezos_raw_protocol_alpha.Script_repr.expr)
      : Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Raw_context.context) :=
      op_atat Lwt.__return
        (Raw_context.consume_gas ctxt (Script_repr.deserialized_cost value)).
    
    Definition get (ctxt : I.context) (contract : I.key)
      : Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Raw_context.context * I.value)) :=
      op_gtgteqquestion (I.get ctxt contract)
        (fun function_parameter =>
          let '(ctxt, value) := function_parameter in
          op_gtgtpipequestion (consume_deserialize_gas ctxt value)
            (fun ctxt => (ctxt, value))).
    
    Definition get_option (ctxt : I.context) (contract : I.key)
      : Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_raw_protocol_alpha.Raw_context.t * option I.value)) :=
      op_gtgteqquestion (I.get_option ctxt contract)
        (fun function_parameter =>
          let '(ctxt, value_opt) := function_parameter in
          match value_opt with
          | None => __return (ctxt, None)
          | Some value =>
            op_gtgtpipequestion (consume_deserialize_gas ctxt value)
              (fun ctxt => (ctxt, value_opt))
          end).
  End Contents.
End Big_map.

(* ❌ Applications of functors are not handled. *)
functor_application

(* ❌ Applications of functors are not handled. *)
functor_application

(* ❌ Applications of functors are not handled. *)
functor_application

(* ❌ Applications of functors are not handled. *)
functor_application

Module Cycle.
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  Module unrevealed_nonce.
    Record record := {
      nonce_hash : Tezos_raw_protocol_alpha.Nonce_hash.t;
      delegate :
        Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t;
      rewards : Tezos_raw_protocol_alpha.Tez_repr.t;
      fees : Tezos_raw_protocol_alpha.Tez_repr.t }.
  End unrevealed_nonce.
  Definition unrevealed_nonce := unrevealed_nonce.record.
  
  Inductive nonce_status : Set :=
  | Unrevealed : unrevealed_nonce -> nonce_status
  | Revealed : Tezos_raw_protocol_alpha.Seed_repr.nonce -> nonce_status.
  
  Definition nonce_status_encoding
    : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
      nonce_status :=
    union None
      (cons
        (__case_value "Unrevealed" % string None
          (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag 0)
          (tup4 Nonce_hash.encoding Signature.Public_key_hash.encoding
            Tez_repr.encoding Tez_repr.encoding)
          (fun function_parameter =>
            match function_parameter with
            |
              Unrevealed {|
                unrevealed_nonce.nonce_hash := nonce_hash;
                  unrevealed_nonce.delegate := delegate;
                  unrevealed_nonce.rewards := rewards;
                  unrevealed_nonce.fees := fees
                  |} => Some (nonce_hash, delegate, rewards, fees)
            | _ => None
            end)
          (fun function_parameter =>
            let '(nonce_hash, delegate, rewards, fees) := function_parameter in
            Unrevealed
              {| unrevealed_nonce.nonce_hash := nonce_hash;
                unrevealed_nonce.delegate := delegate;
                unrevealed_nonce.rewards := rewards;
                unrevealed_nonce.fees := fees |}))
        (cons
          (__case_value "Revealed" % string None
            (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag 1)
            Seed_repr.nonce_encoding
            (fun function_parameter =>
              match function_parameter with
              | Revealed nonce => Some nonce
              | _ => None
              end) (fun nonce => Revealed nonce)) [])).
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
End Cycle.

Module Roll.
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  Module Snapshoted_owner_index.
    Definition t := Tezos_raw_protocol_alpha.Cycle_repr.t * Z.
    
    Definition path_length : Z := op_plus Cycle_repr.Index.path_length 1.
    
    Definition to_path
      (function_parameter : Tezos_raw_protocol_alpha.Cycle_repr.Index.t * Z)
      : list string -> list string :=
      let '(c, n) := function_parameter in
      fun s => Cycle_repr.Index.to_path c (cons (string_of_int n) s).
    
    Definition of_path (l : list string)
      : option (Tezos_raw_protocol_alpha.Cycle_repr.Index.t * Z) :=
      match Misc.take Cycle_repr.Index.path_length l with
      | None | Some (_, [] | cons _ (cons _ _)) => None
      | Some (l1, cons l2 []) =>
        match ((Cycle_repr.Index.of_path l1), (int_of_string_opt l2)) with
        | (None, _) | (_, None) => None
        | (Some c, Some i) => Some (c, i)
        end
      end.
    
    Definition ipath (a : Set) :=
      (a * Tezos_raw_protocol_alpha.Cycle_repr.t) * Z.
    
    Definition left_args {A : Set}
      : Tezos_raw_protocol_alpha.Storage_description.args A
        Tezos_raw_protocol_alpha.Cycle_repr.cycle
        (A * Tezos_raw_protocol_alpha.Cycle_repr.cycle) :=
      Tezos_raw_protocol_alpha.Storage_description.One
        {|
          Tezos_raw_protocol_alpha.Storage_description.args.One.rpc_arg :=
            Cycle_repr.rpc_arg;
          Tezos_raw_protocol_alpha.Storage_description.args.One.encoding :=
            Cycle_repr.encoding;
          Tezos_raw_protocol_alpha.Storage_description.args.One.compare :=
            Cycle_repr.compare |}.
    
    Definition right_args {A : Set}
      : Tezos_raw_protocol_alpha.Storage_description.args A
        Tezos_protocol_environment_alpha__Environment.Compare.Int.t
        (A * Tezos_protocol_environment_alpha__Environment.Compare.Int.t) :=
      Tezos_raw_protocol_alpha.Storage_description.One
        {|
          Tezos_raw_protocol_alpha.Storage_description.args.One.rpc_arg :=
            RPC_arg.int;
          Tezos_raw_protocol_alpha.Storage_description.args.One.encoding :=
            Data_encoding.int31;
          Tezos_raw_protocol_alpha.Storage_description.args.One.compare :=
            Compare.Int.compare |}.
    
    Definition args {A : Set}
      : Tezos_raw_protocol_alpha.Storage_description.args A
        (Tezos_raw_protocol_alpha.Cycle_repr.cycle *
          Tezos_protocol_environment_alpha__Environment.Compare.Int.t)
        ((A * Tezos_raw_protocol_alpha.Cycle_repr.cycle) *
          Tezos_protocol_environment_alpha__Environment.Compare.Int.t) :=
      Tezos_raw_protocol_alpha.Storage_description.Pair left_args right_args.
  End Snapshoted_owner_index.
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  Module Snapshot_for_cycle := Cycle.Roll_snapshot.
  
  Module Last_for_snapshot := Cycle.Last_roll.
  
  Definition clear
    : Indexed_context.context ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      Tezos_raw_protocol_alpha.Raw_context.t := Indexed_context.clear.
End Roll.

Module Vote.
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
End Vote.

Module Seed.
  Module unrevealed_nonce.
    Record record := {
      nonce_hash : Tezos_raw_protocol_alpha.Nonce_hash.t;
      delegate :
        Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t;
      rewards : Tezos_raw_protocol_alpha.Tez_repr.t;
      fees : Tezos_raw_protocol_alpha.Tez_repr.t }.
  End unrevealed_nonce.
  Definition unrevealed_nonce := unrevealed_nonce.record.
  
  Inductive nonce_status : Set :=
  | Unrevealed : unrevealed_nonce -> nonce_status
  | Revealed : Tezos_raw_protocol_alpha.Seed_repr.nonce -> nonce_status.
  
  Module Nonce.
    Import Level_repr.
    
    Definition context := Tezos_raw_protocol_alpha.Raw_context.t.
    
    Definition mem
      (ctxt : Cycle.Indexed_context.t)
      (l : Tezos_raw_protocol_alpha.Level_repr.t)
      : Tezos_protocol_environment_alpha__Environment.Lwt.t bool :=
      Cycle.Nonce.mem (ctxt, (Tezos_raw_protocol_alpha.Level_repr.t.cycle l))
        (Tezos_raw_protocol_alpha.Level_repr.t.level l).
    
    Definition get
      (ctxt : Cycle.Indexed_context.t)
      (l : Tezos_raw_protocol_alpha.Level_repr.t)
      : Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Cycle.Nonce.value) :=
      Cycle.Nonce.get (ctxt, (Tezos_raw_protocol_alpha.Level_repr.t.cycle l))
        (Tezos_raw_protocol_alpha.Level_repr.t.level l).
    
    Definition get_option
      (ctxt : Cycle.Indexed_context.t)
      (l : Tezos_raw_protocol_alpha.Level_repr.t)
      : Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (option Cycle.Nonce.value)) :=
      Cycle.Nonce.get_option
        (ctxt, (Tezos_raw_protocol_alpha.Level_repr.t.cycle l))
        (Tezos_raw_protocol_alpha.Level_repr.t.level l).
    
    Definition set
      (ctxt : Cycle.Indexed_context.t)
      (l : Tezos_raw_protocol_alpha.Level_repr.t) (v : Cycle.Nonce.value)
      : Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t) :=
      Cycle.Nonce.set (ctxt, (Tezos_raw_protocol_alpha.Level_repr.t.cycle l))
        (Tezos_raw_protocol_alpha.Level_repr.t.level l) v.
    
    Definition init
      (ctxt : Cycle.Indexed_context.t)
      (l : Tezos_raw_protocol_alpha.Level_repr.t) (v : Cycle.Nonce.value)
      : Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t) :=
      Cycle.Nonce.init (ctxt, (Tezos_raw_protocol_alpha.Level_repr.t.cycle l))
        (Tezos_raw_protocol_alpha.Level_repr.t.level l) v.
    
    Definition init_set
      (ctxt : Cycle.Indexed_context.t)
      (l : Tezos_raw_protocol_alpha.Level_repr.t) (v : Cycle.Nonce.value)
      : Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t :=
      Cycle.Nonce.init_set
        (ctxt, (Tezos_raw_protocol_alpha.Level_repr.t.cycle l))
        (Tezos_raw_protocol_alpha.Level_repr.t.level l) v.
    
    Definition set_option
      (ctxt : Cycle.Indexed_context.t)
      (l : Tezos_raw_protocol_alpha.Level_repr.t) (v : option Cycle.Nonce.value)
      : Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t :=
      Cycle.Nonce.set_option
        (ctxt, (Tezos_raw_protocol_alpha.Level_repr.t.cycle l))
        (Tezos_raw_protocol_alpha.Level_repr.t.level l) v.
    
    Definition delete
      (ctxt : Cycle.Indexed_context.t)
      (l : Tezos_raw_protocol_alpha.Level_repr.t)
      : Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t) :=
      Cycle.Nonce.delete (ctxt, (Tezos_raw_protocol_alpha.Level_repr.t.cycle l))
        (Tezos_raw_protocol_alpha.Level_repr.t.level l).
    
    Definition remove
      (ctxt : Cycle.Indexed_context.t)
      (l : Tezos_raw_protocol_alpha.Level_repr.t)
      : Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t :=
      Cycle.Nonce.remove (ctxt, (Tezos_raw_protocol_alpha.Level_repr.t.cycle l))
        (Tezos_raw_protocol_alpha.Level_repr.t.level l).
  End Nonce.
  
  Module For_cycle := Cycle.Seed.
End Seed.

(* ❌ Applications of functors are not handled. *)
functor_application

Module Ramp_up.
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
End Ramp_up.

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

(** Tezos Protocol Implementation - Typed storage

    This module hides the hierarchical (key x value) database under
    pre-allocated typed accessors for all persistent entities of the
    tezos context.

    This interface enforces no invariant on the contents of the
    database. Its goal is to centralize all accessors in order to have
    a complete view over the database contents and avoid key
    collisions. *)

open Storage_sigs

module Block_priority : sig
  val get : Raw_context.t -> int tzresult Lwt.t

  val set : Raw_context.t -> int -> Raw_context.t tzresult Lwt.t

  val init : Raw_context.t -> int -> Raw_context.t tzresult Lwt.t
end

module Roll : sig
  (** Storage from this submodule must only be accessed through the
      module `Roll`. *)

  module Owner :
    Indexed_data_snapshotable_storage
      with type key = Roll_repr.t
       and type snapshot = Cycle_repr.t * int
       and type value = Signature.Public_key.t
       and type t := Raw_context.t

  val clear : Raw_context.t -> Raw_context.t Lwt.t

  (** The next roll to be allocated. *)
  module Next :
    Single_data_storage
      with type value = Roll_repr.t
       and type t := Raw_context.t

  (** Rolls linked lists represent both account owned and free rolls.
      All rolls belongs either to the limbo list or to an owned list. *)

  (** Head of the linked list of rolls in limbo *)
  module Limbo :
    Single_data_storage
      with type value = Roll_repr.t
       and type t := Raw_context.t

  (** Rolls associated to contracts, a linked list per contract *)
  module Delegate_roll_list :
    Indexed_data_storage
      with type key = Signature.Public_key_hash.t
       and type value = Roll_repr.t
       and type t := Raw_context.t

  (** Use this to iter on a linked list of rolls *)
  module Successor :
    Indexed_data_storage
      with type key = Roll_repr.t
       and type value = Roll_repr.t
       and type t := Raw_context.t

  (** The tez of a contract that are not assigned to rolls *)
  module Delegate_change :
    Indexed_data_storage
      with type key = Signature.Public_key_hash.t
       and type value = Tez_repr.t
       and type t := Raw_context.t

  (** Index of the randomly selected roll snapshot of a given cycle. *)
  module Snapshot_for_cycle :
    Indexed_data_storage
      with type key = Cycle_repr.t
       and type value = int
       and type t := Raw_context.t

  (** Last roll in the snapshoted roll allocation of a given cycle. *)
  module Last_for_snapshot :
    Indexed_data_storage
      with type key = int
       and type value = Roll_repr.t
       and type t = Raw_context.t * Cycle_repr.t
end

module Contract : sig
  (** Storage from this submodule must only be accessed through the
      module `Contract`. *)

  module Global_counter : sig
    val get : Raw_context.t -> Z.t tzresult Lwt.t

    val set : Raw_context.t -> Z.t -> Raw_context.t tzresult Lwt.t

    val init : Raw_context.t -> Z.t -> Raw_context.t tzresult Lwt.t
  end

  (** The domain of alive contracts *)
  val fold :
    Raw_context.t ->
    init:'a ->
    f:(Contract_repr.t -> 'a -> 'a Lwt.t) ->
    'a Lwt.t

  val list : Raw_context.t -> Contract_repr.t list Lwt.t

  (** All the tez possesed by a contract, including rolls and change *)
  module Balance :
    Indexed_data_storage
      with type key = Contract_repr.t
       and type value = Tez_repr.t
       and type t := Raw_context.t

  (** Frozen balance, see 'delegate_storage.mli' for more explanation.
      Always update `Delegates_with_frozen_balance` accordingly. *)
  module Frozen_deposits :
    Indexed_data_storage
      with type key = Cycle_repr.t
       and type value = Tez_repr.t
       and type t = Raw_context.t * Contract_repr.t

  module Frozen_fees :
    Indexed_data_storage
      with type key = Cycle_repr.t
       and type value = Tez_repr.t
       and type t = Raw_context.t * Contract_repr.t

  module Frozen_rewards :
    Indexed_data_storage
      with type key = Cycle_repr.t
       and type value = Tez_repr.t
       and type t = Raw_context.t * Contract_repr.t

  (** The manager of a contract *)
  module Manager :
    Indexed_data_storage
      with type key = Contract_repr.t
       and type value = Manager_repr.t
       and type t := Raw_context.t

  (** The delegate of a contract, if any. *)
  module Delegate :
    Indexed_data_storage
      with type key = Contract_repr.t
       and type value = Signature.Public_key_hash.t
       and type t := Raw_context.t

  (** All contracts (implicit and originated) that are delegated, if any  *)
  module Delegated :
    Data_set_storage
      with type elt = Contract_repr.t
       and type t = Raw_context.t * Contract_repr.t

  module Inactive_delegate :
    Data_set_storage with type elt = Contract_repr.t and type t = Raw_context.t

  (** The cycle where the delegate should be desactivated. *)
  module Delegate_desactivation :
    Indexed_data_storage
      with type key = Contract_repr.t
       and type value = Cycle_repr.t
       and type t := Raw_context.t

  module Counter :
    Indexed_data_storage
      with type key = Contract_repr.t
       and type value = Z.t
       and type t := Raw_context.t

  module Code :
    Non_iterable_indexed_carbonated_data_storage
      with type key = Contract_repr.t
       and type value = Script_repr.lazy_expr
       and type t := Raw_context.t

  module Storage :
    Non_iterable_indexed_carbonated_data_storage
      with type key = Contract_repr.t
       and type value = Script_repr.lazy_expr
       and type t := Raw_context.t

  (** Current storage space in bytes.
      Includes code, global storage and big map elements. *)
  module Used_storage_space :
    Indexed_data_storage
      with type key = Contract_repr.t
       and type value = Z.t
       and type t := Raw_context.t

  (** Maximal space available without needing to burn new fees. *)
  module Paid_storage_space :
    Indexed_data_storage
      with type key = Contract_repr.t
       and type value = Z.t
       and type t := Raw_context.t
end

module Big_map : sig
  module Next : sig
    val incr : Raw_context.t -> (Raw_context.t * Z.t) tzresult Lwt.t

    val init : Raw_context.t -> Raw_context.t tzresult Lwt.t
  end

  (** The domain of alive big maps *)
  val fold : Raw_context.t -> init:'a -> f:(Z.t -> 'a -> 'a Lwt.t) -> 'a Lwt.t

  val list : Raw_context.t -> Z.t list Lwt.t

  val remove_rec : Raw_context.t -> Z.t -> Raw_context.t Lwt.t

  val copy :
    Raw_context.t -> from:Z.t -> to_:Z.t -> Raw_context.t tzresult Lwt.t

  type key = Raw_context.t * Z.t

  val rpc_arg : Z.t RPC_arg.t

  module Contents :
    Non_iterable_indexed_carbonated_data_storage
      with type key = Script_expr_hash.t
       and type value = Script_repr.expr
       and type t := key

  module Total_bytes :
    Indexed_data_storage
      with type key = Z.t
       and type value = Z.t
       and type t := Raw_context.t

  module Key_type :
    Indexed_data_storage
      with type key = Z.t
       and type value = Script_repr.expr
       and type t := Raw_context.t

  module Value_type :
    Indexed_data_storage
      with type key = Z.t
       and type value = Script_repr.expr
       and type t := Raw_context.t
end

(** Set of all registered delegates. *)
module Delegates :
  Data_set_storage
    with type t := Raw_context.t
     and type elt = Signature.Public_key_hash.t

(** Set of all active delegates with rolls. *)
module Active_delegates_with_rolls :
  Data_set_storage
    with type t := Raw_context.t
     and type elt = Signature.Public_key_hash.t

(** Set of all the delegates with frozen rewards/bonds/fees for a given cycle. *)
module Delegates_with_frozen_balance :
  Data_set_storage
    with type t = Raw_context.t * Cycle_repr.t
     and type elt = Signature.Public_key_hash.t

(** Votes *)

module Vote : sig
  module Current_period_kind :
    Single_data_storage
      with type value = Voting_period_repr.kind
       and type t := Raw_context.t

  (** Participation exponential moving average, in centile of percentage *)
  module Participation_ema :
    Single_data_storage with type value = int32 and type t := Raw_context.t

  module Current_proposal :
    Single_data_storage
      with type value = Protocol_hash.t
       and type t := Raw_context.t

  (** Sum of all rolls of all delegates. *)
  module Listings_size :
    Single_data_storage with type value = int32 and type t := Raw_context.t

  (** Contains all delegates with their assigned number of rolls. *)
  module Listings :
    Indexed_data_storage
      with type key = Signature.Public_key_hash.t
       and type value = int32
       and type t := Raw_context.t

  (** Set of protocol proposal with corresponding proposer delegate *)
  module Proposals :
    Data_set_storage
      with type elt = Protocol_hash.t * Signature.Public_key_hash.t
       and type t := Raw_context.t

  (** Keeps for each delegate the number of proposed protocols *)
  module Proposals_count :
    Indexed_data_storage
      with type key = Signature.Public_key_hash.t
       and type value = int
       and type t := Raw_context.t

  (** Contains for each delegate its ballot *)
  module Ballots :
    Indexed_data_storage
      with type key = Signature.Public_key_hash.t
       and type value = Vote_repr.ballot
       and type t := Raw_context.t
end

(** Seed *)

module Seed : sig
  (** Storage from this submodule must only be accessed through the
      module `Seed`. *)

  type unrevealed_nonce = {
    nonce_hash : Nonce_hash.t;
    delegate : Signature.Public_key_hash.t;
    rewards : Tez_repr.t;
    fees : Tez_repr.t;
  }

  type nonce_status =
    | Unrevealed of unrevealed_nonce
    | Revealed of Seed_repr.nonce

  module Nonce :
    Non_iterable_indexed_data_storage
      with type key := Level_repr.t
       and type value := nonce_status
       and type t := Raw_context.t

  module For_cycle : sig
    val init :
      Raw_context.t ->
      Cycle_repr.t ->
      Seed_repr.seed ->
      Raw_context.t tzresult Lwt.t

    val get : Raw_context.t -> Cycle_repr.t -> Seed_repr.seed tzresult Lwt.t

    val delete : Raw_context.t -> Cycle_repr.t -> Raw_context.t tzresult Lwt.t
  end
end

(** Commitments *)

module Commitments :
  Indexed_data_storage
    with type key = Blinded_public_key_hash.t
     and type value = Tez_repr.t
     and type t := Raw_context.t

(** Ramp up security deposits... *)

module Ramp_up : sig
  module Rewards :
    Indexed_data_storage
      with type key = Cycle_repr.t
       and type value = Tez_repr.t * Tez_repr.t
      (* baking * endorsement *)
       and type t := Raw_context.t

  module Security_deposits :
    Indexed_data_storage
      with type key = Cycle_repr.t
       and type value = Tez_repr.t * Tez_repr.t
      (* baking * endorsement *)
       and type t := Raw_context.t
end

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Module Block_priority.
  Parameter get :
    Tezos_raw_protocol_alpha.Raw_context.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult Z).
  
  Parameter set :
    Tezos_raw_protocol_alpha.Raw_context.t -> Z ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        Tezos_raw_protocol_alpha.Raw_context.t).
  
  Parameter init :
    Tezos_raw_protocol_alpha.Raw_context.t -> Z ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        Tezos_raw_protocol_alpha.Raw_context.t).
End Block_priority.

Module Roll.
  Module Owner.
    Definition snapshot := Tezos_raw_protocol_alpha.Cycle_repr.t * Z.
    
    Definition key := Tezos_raw_protocol_alpha.Roll_repr.t.
    
    Definition context := Tezos_raw_protocol_alpha.Raw_context.t.
    
    Definition value :=
      Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t.
    
    Parameter mem :
      context -> key -> Tezos_protocol_environment_alpha__Environment.Lwt.t bool.
    
    Parameter get :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          value).
    
    Parameter get_option :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (option value)).
    
    Parameter set :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter init :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter init_set :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter set_option :
      context -> key -> option value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter delete :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter remove :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter clear :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter keys :
      context -> Tezos_protocol_environment_alpha__Environment.Lwt.t (list key).
    
    Parameter bindings :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t (list (key * value)).
    
    Parameter fold : forall {a : Set},
      context -> a ->
      (key -> value -> a ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a.
    
    Parameter fold_keys : forall {a : Set},
      context -> a ->
      (key -> a -> Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a.
    
    Module Snapshot.
      Definition t := Tezos_raw_protocol_alpha.Raw_context.t.
      
      Definition context := t.
      
      Definition key := snapshot * key.
      
      Definition value := value.
      
      Parameter mem :
        context -> key ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t bool.
      
      Parameter get :
        context -> key ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
            value).
      
      Parameter get_option :
        context -> key ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
            (option value)).
      
      Parameter set :
        context -> key -> value ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
            Tezos_raw_protocol_alpha.Raw_context.t).
      
      Parameter init :
        context -> key -> value ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
            Tezos_raw_protocol_alpha.Raw_context.t).
      
      Parameter init_set :
        context -> key -> value ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          Tezos_raw_protocol_alpha.Raw_context.t.
      
      Parameter set_option :
        context -> key -> option value ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          Tezos_raw_protocol_alpha.Raw_context.t.
      
      Parameter delete :
        context -> key ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
            Tezos_raw_protocol_alpha.Raw_context.t).
      
      Parameter remove :
        context -> key ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          Tezos_raw_protocol_alpha.Raw_context.t.
      
      Parameter clear :
        context ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          Tezos_raw_protocol_alpha.Raw_context.t.
      
      Parameter keys :
        context ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t (list key).
      
      Parameter bindings :
        context ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t (list (key * value)).
      
      Parameter fold : forall {a : Set},
        context -> a ->
        (key -> value -> a ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t a.
      
      Parameter fold_keys : forall {a : Set},
        context -> a ->
        (key -> a -> Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t a.
    End Snapshot.
    
    Parameter snapshot_exists :
      context -> snapshot ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t bool.
    
    Parameter snapshot :
      context -> snapshot ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter delete_snapshot :
      context -> snapshot ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
  End Owner.
  
  Parameter clear :
    Tezos_raw_protocol_alpha.Raw_context.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      Tezos_raw_protocol_alpha.Raw_context.t.
  
  Module Next.
    Definition context := Tezos_raw_protocol_alpha.Raw_context.t.
    
    Definition value := Tezos_raw_protocol_alpha.Roll_repr.t.
    
    Parameter mem :
      context -> Tezos_protocol_environment_alpha__Environment.Lwt.t bool.
    
    Parameter get :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          value).
    
    Parameter get_option :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (option value)).
    
    Parameter init :
      context -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter set :
      context -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter init_set :
      context -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter set_option :
      context -> option value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter delete :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter remove :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
  End Next.
  
  Module Limbo.
    Definition context := Tezos_raw_protocol_alpha.Raw_context.t.
    
    Definition value := Tezos_raw_protocol_alpha.Roll_repr.t.
    
    Parameter mem :
      context -> Tezos_protocol_environment_alpha__Environment.Lwt.t bool.
    
    Parameter get :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          value).
    
    Parameter get_option :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (option value)).
    
    Parameter init :
      context -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter set :
      context -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter init_set :
      context -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter set_option :
      context -> option value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter delete :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter remove :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
  End Limbo.
  
  Module Delegate_roll_list.
    Definition context := Tezos_raw_protocol_alpha.Raw_context.t.
    
    Definition key :=
      Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t.
    
    Definition value := Tezos_raw_protocol_alpha.Roll_repr.t.
    
    Parameter mem :
      context -> key -> Tezos_protocol_environment_alpha__Environment.Lwt.t bool.
    
    Parameter get :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          value).
    
    Parameter get_option :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (option value)).
    
    Parameter set :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter init :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter init_set :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter set_option :
      context -> key -> option value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter delete :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter remove :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter clear :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter keys :
      context -> Tezos_protocol_environment_alpha__Environment.Lwt.t (list key).
    
    Parameter bindings :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t (list (key * value)).
    
    Parameter fold : forall {a : Set},
      context -> a ->
      (key -> value -> a ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a.
    
    Parameter fold_keys : forall {a : Set},
      context -> a ->
      (key -> a -> Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a.
  End Delegate_roll_list.
  
  Module Successor.
    Definition context := Tezos_raw_protocol_alpha.Raw_context.t.
    
    Definition key := Tezos_raw_protocol_alpha.Roll_repr.t.
    
    Definition value := Tezos_raw_protocol_alpha.Roll_repr.t.
    
    Parameter mem :
      context -> key -> Tezos_protocol_environment_alpha__Environment.Lwt.t bool.
    
    Parameter get :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          value).
    
    Parameter get_option :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (option value)).
    
    Parameter set :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter init :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter init_set :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter set_option :
      context -> key -> option value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter delete :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter remove :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter clear :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter keys :
      context -> Tezos_protocol_environment_alpha__Environment.Lwt.t (list key).
    
    Parameter bindings :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t (list (key * value)).
    
    Parameter fold : forall {a : Set},
      context -> a ->
      (key -> value -> a ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a.
    
    Parameter fold_keys : forall {a : Set},
      context -> a ->
      (key -> a -> Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a.
  End Successor.
  
  Module Delegate_change.
    Definition context := Tezos_raw_protocol_alpha.Raw_context.t.
    
    Definition key :=
      Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t.
    
    Definition value := Tezos_raw_protocol_alpha.Tez_repr.t.
    
    Parameter mem :
      context -> key -> Tezos_protocol_environment_alpha__Environment.Lwt.t bool.
    
    Parameter get :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          value).
    
    Parameter get_option :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (option value)).
    
    Parameter set :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter init :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter init_set :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter set_option :
      context -> key -> option value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter delete :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter remove :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter clear :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter keys :
      context -> Tezos_protocol_environment_alpha__Environment.Lwt.t (list key).
    
    Parameter bindings :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t (list (key * value)).
    
    Parameter fold : forall {a : Set},
      context -> a ->
      (key -> value -> a ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a.
    
    Parameter fold_keys : forall {a : Set},
      context -> a ->
      (key -> a -> Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a.
  End Delegate_change.
  
  Module Snapshot_for_cycle.
    Definition context := Tezos_raw_protocol_alpha.Raw_context.t.
    
    Definition key := Tezos_raw_protocol_alpha.Cycle_repr.t.
    
    Definition value := Z.
    
    Parameter mem :
      context -> key -> Tezos_protocol_environment_alpha__Environment.Lwt.t bool.
    
    Parameter get :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          value).
    
    Parameter get_option :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (option value)).
    
    Parameter set :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter init :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter init_set :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter set_option :
      context -> key -> option value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter delete :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter remove :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter clear :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter keys :
      context -> Tezos_protocol_environment_alpha__Environment.Lwt.t (list key).
    
    Parameter bindings :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t (list (key * value)).
    
    Parameter fold : forall {a : Set},
      context -> a ->
      (key -> value -> a ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a.
    
    Parameter fold_keys : forall {a : Set},
      context -> a ->
      (key -> a -> Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a.
  End Snapshot_for_cycle.
  
  Module Last_for_snapshot.
    Definition t :=
      Tezos_raw_protocol_alpha.Raw_context.t *
        Tezos_raw_protocol_alpha.Cycle_repr.t.
    
    Definition context := t.
    
    Definition key := Z.
    
    Definition value := Tezos_raw_protocol_alpha.Roll_repr.t.
    
    Parameter mem :
      context -> key -> Tezos_protocol_environment_alpha__Environment.Lwt.t bool.
    
    Parameter get :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          value).
    
    Parameter get_option :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (option value)).
    
    Parameter set :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter init :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter init_set :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter set_option :
      context -> key -> option value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter delete :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter remove :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter clear :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter keys :
      context -> Tezos_protocol_environment_alpha__Environment.Lwt.t (list key).
    
    Parameter bindings :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t (list (key * value)).
    
    Parameter fold : forall {a : Set},
      context -> a ->
      (key -> value -> a ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a.
    
    Parameter fold_keys : forall {a : Set},
      context -> a ->
      (key -> a -> Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a.
  End Last_for_snapshot.
End Roll.

Module Contract.
  Module Global_counter.
    Parameter get :
      Tezos_raw_protocol_alpha.Raw_context.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_protocol_environment_alpha__Environment.Z.t).
    
    Parameter set :
      Tezos_raw_protocol_alpha.Raw_context.t ->
      Tezos_protocol_environment_alpha__Environment.Z.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter init :
      Tezos_raw_protocol_alpha.Raw_context.t ->
      Tezos_protocol_environment_alpha__Environment.Z.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
  End Global_counter.
  
  Parameter fold : forall {a : Set},
    Tezos_raw_protocol_alpha.Raw_context.t -> a ->
    (Tezos_raw_protocol_alpha.Contract_repr.t -> a ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t a.
  
  Parameter __list_value :
    Tezos_raw_protocol_alpha.Raw_context.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (list Tezos_raw_protocol_alpha.Contract_repr.t).
  
  Module Balance.
    Definition context := Tezos_raw_protocol_alpha.Raw_context.t.
    
    Definition key := Tezos_raw_protocol_alpha.Contract_repr.t.
    
    Definition value := Tezos_raw_protocol_alpha.Tez_repr.t.
    
    Parameter mem :
      context -> key -> Tezos_protocol_environment_alpha__Environment.Lwt.t bool.
    
    Parameter get :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          value).
    
    Parameter get_option :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (option value)).
    
    Parameter set :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter init :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter init_set :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter set_option :
      context -> key -> option value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter delete :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter remove :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter clear :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter keys :
      context -> Tezos_protocol_environment_alpha__Environment.Lwt.t (list key).
    
    Parameter bindings :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t (list (key * value)).
    
    Parameter fold : forall {a : Set},
      context -> a ->
      (key -> value -> a ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a.
    
    Parameter fold_keys : forall {a : Set},
      context -> a ->
      (key -> a -> Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a.
  End Balance.
  
  Module Frozen_deposits.
    Definition t :=
      Tezos_raw_protocol_alpha.Raw_context.t *
        Tezos_raw_protocol_alpha.Contract_repr.t.
    
    Definition context := t.
    
    Definition key := Tezos_raw_protocol_alpha.Cycle_repr.t.
    
    Definition value := Tezos_raw_protocol_alpha.Tez_repr.t.
    
    Parameter mem :
      context -> key -> Tezos_protocol_environment_alpha__Environment.Lwt.t bool.
    
    Parameter get :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          value).
    
    Parameter get_option :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (option value)).
    
    Parameter set :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter init :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter init_set :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter set_option :
      context -> key -> option value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter delete :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter remove :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter clear :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter keys :
      context -> Tezos_protocol_environment_alpha__Environment.Lwt.t (list key).
    
    Parameter bindings :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t (list (key * value)).
    
    Parameter fold : forall {a : Set},
      context -> a ->
      (key -> value -> a ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a.
    
    Parameter fold_keys : forall {a : Set},
      context -> a ->
      (key -> a -> Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a.
  End Frozen_deposits.
  
  Module Frozen_fees.
    Definition t :=
      Tezos_raw_protocol_alpha.Raw_context.t *
        Tezos_raw_protocol_alpha.Contract_repr.t.
    
    Definition context := t.
    
    Definition key := Tezos_raw_protocol_alpha.Cycle_repr.t.
    
    Definition value := Tezos_raw_protocol_alpha.Tez_repr.t.
    
    Parameter mem :
      context -> key -> Tezos_protocol_environment_alpha__Environment.Lwt.t bool.
    
    Parameter get :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          value).
    
    Parameter get_option :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (option value)).
    
    Parameter set :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter init :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter init_set :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter set_option :
      context -> key -> option value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter delete :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter remove :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter clear :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter keys :
      context -> Tezos_protocol_environment_alpha__Environment.Lwt.t (list key).
    
    Parameter bindings :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t (list (key * value)).
    
    Parameter fold : forall {a : Set},
      context -> a ->
      (key -> value -> a ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a.
    
    Parameter fold_keys : forall {a : Set},
      context -> a ->
      (key -> a -> Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a.
  End Frozen_fees.
  
  Module Frozen_rewards.
    Definition t :=
      Tezos_raw_protocol_alpha.Raw_context.t *
        Tezos_raw_protocol_alpha.Contract_repr.t.
    
    Definition context := t.
    
    Definition key := Tezos_raw_protocol_alpha.Cycle_repr.t.
    
    Definition value := Tezos_raw_protocol_alpha.Tez_repr.t.
    
    Parameter mem :
      context -> key -> Tezos_protocol_environment_alpha__Environment.Lwt.t bool.
    
    Parameter get :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          value).
    
    Parameter get_option :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (option value)).
    
    Parameter set :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter init :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter init_set :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter set_option :
      context -> key -> option value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter delete :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter remove :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter clear :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter keys :
      context -> Tezos_protocol_environment_alpha__Environment.Lwt.t (list key).
    
    Parameter bindings :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t (list (key * value)).
    
    Parameter fold : forall {a : Set},
      context -> a ->
      (key -> value -> a ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a.
    
    Parameter fold_keys : forall {a : Set},
      context -> a ->
      (key -> a -> Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a.
  End Frozen_rewards.
  
  Module Manager.
    Definition context := Tezos_raw_protocol_alpha.Raw_context.t.
    
    Definition key := Tezos_raw_protocol_alpha.Contract_repr.t.
    
    Definition value := Tezos_raw_protocol_alpha.Manager_repr.t.
    
    Parameter mem :
      context -> key -> Tezos_protocol_environment_alpha__Environment.Lwt.t bool.
    
    Parameter get :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          value).
    
    Parameter get_option :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (option value)).
    
    Parameter set :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter init :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter init_set :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter set_option :
      context -> key -> option value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter delete :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter remove :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter clear :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter keys :
      context -> Tezos_protocol_environment_alpha__Environment.Lwt.t (list key).
    
    Parameter bindings :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t (list (key * value)).
    
    Parameter fold : forall {a : Set},
      context -> a ->
      (key -> value -> a ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a.
    
    Parameter fold_keys : forall {a : Set},
      context -> a ->
      (key -> a -> Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a.
  End Manager.
  
  Module Delegate.
    Definition context := Tezos_raw_protocol_alpha.Raw_context.t.
    
    Definition key := Tezos_raw_protocol_alpha.Contract_repr.t.
    
    Definition value :=
      Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t.
    
    Parameter mem :
      context -> key -> Tezos_protocol_environment_alpha__Environment.Lwt.t bool.
    
    Parameter get :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          value).
    
    Parameter get_option :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (option value)).
    
    Parameter set :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter init :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter init_set :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter set_option :
      context -> key -> option value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter delete :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter remove :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter clear :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter keys :
      context -> Tezos_protocol_environment_alpha__Environment.Lwt.t (list key).
    
    Parameter bindings :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t (list (key * value)).
    
    Parameter fold : forall {a : Set},
      context -> a ->
      (key -> value -> a ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a.
    
    Parameter fold_keys : forall {a : Set},
      context -> a ->
      (key -> a -> Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a.
  End Delegate.
  
  Module Delegated.
    Definition t :=
      Tezos_raw_protocol_alpha.Raw_context.t *
        Tezos_raw_protocol_alpha.Contract_repr.t.
    
    Definition context := t.
    
    Definition elt := Tezos_raw_protocol_alpha.Contract_repr.t.
    
    Parameter mem :
      context -> elt -> Tezos_protocol_environment_alpha__Environment.Lwt.t bool.
    
    Parameter add :
      context -> elt ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter del :
      context -> elt ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter set :
      context -> elt -> bool ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter elements :
      context -> Tezos_protocol_environment_alpha__Environment.Lwt.t (list elt).
    
    Parameter fold : forall {a : Set},
      context -> a ->
      (elt -> a -> Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a.
    
    Parameter clear :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
  End Delegated.
  
  Module Inactive_delegate.
    Definition t := Tezos_raw_protocol_alpha.Raw_context.t.
    
    Definition context := t.
    
    Definition elt := Tezos_raw_protocol_alpha.Contract_repr.t.
    
    Parameter mem :
      context -> elt -> Tezos_protocol_environment_alpha__Environment.Lwt.t bool.
    
    Parameter add :
      context -> elt ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter del :
      context -> elt ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter set :
      context -> elt -> bool ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter elements :
      context -> Tezos_protocol_environment_alpha__Environment.Lwt.t (list elt).
    
    Parameter fold : forall {a : Set},
      context -> a ->
      (elt -> a -> Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a.
    
    Parameter clear :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
  End Inactive_delegate.
  
  Module Delegate_desactivation.
    Definition context := Tezos_raw_protocol_alpha.Raw_context.t.
    
    Definition key := Tezos_raw_protocol_alpha.Contract_repr.t.
    
    Definition value := Tezos_raw_protocol_alpha.Cycle_repr.t.
    
    Parameter mem :
      context -> key -> Tezos_protocol_environment_alpha__Environment.Lwt.t bool.
    
    Parameter get :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          value).
    
    Parameter get_option :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (option value)).
    
    Parameter set :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter init :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter init_set :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter set_option :
      context -> key -> option value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter delete :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter remove :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter clear :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter keys :
      context -> Tezos_protocol_environment_alpha__Environment.Lwt.t (list key).
    
    Parameter bindings :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t (list (key * value)).
    
    Parameter fold : forall {a : Set},
      context -> a ->
      (key -> value -> a ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a.
    
    Parameter fold_keys : forall {a : Set},
      context -> a ->
      (key -> a -> Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a.
  End Delegate_desactivation.
  
  Module Counter.
    Definition context := Tezos_raw_protocol_alpha.Raw_context.t.
    
    Definition key := Tezos_raw_protocol_alpha.Contract_repr.t.
    
    Definition value := Tezos_protocol_environment_alpha__Environment.Z.t.
    
    Parameter mem :
      context -> key -> Tezos_protocol_environment_alpha__Environment.Lwt.t bool.
    
    Parameter get :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          value).
    
    Parameter get_option :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (option value)).
    
    Parameter set :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter init :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter init_set :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter set_option :
      context -> key -> option value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter delete :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter remove :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter clear :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter keys :
      context -> Tezos_protocol_environment_alpha__Environment.Lwt.t (list key).
    
    Parameter bindings :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t (list (key * value)).
    
    Parameter fold : forall {a : Set},
      context -> a ->
      (key -> value -> a ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a.
    
    Parameter fold_keys : forall {a : Set},
      context -> a ->
      (key -> a -> Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a.
  End Counter.
  
  Module Code.
    Definition context := Tezos_raw_protocol_alpha.Raw_context.t.
    
    Definition key := Tezos_raw_protocol_alpha.Contract_repr.t.
    
    Definition value := Tezos_raw_protocol_alpha.Script_repr.lazy_expr.
    
    Parameter mem :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_raw_protocol_alpha.Raw_context.t * bool)).
    
    Parameter get :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_raw_protocol_alpha.Raw_context.t * value)).
    
    Parameter get_option :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_raw_protocol_alpha.Raw_context.t * option value)).
    
    Parameter set :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_raw_protocol_alpha.Raw_context.t * Z)).
    
    Parameter init :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_raw_protocol_alpha.Raw_context.t * Z)).
    
    Parameter init_set :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_raw_protocol_alpha.Raw_context.t * Z * bool)).
    
    Parameter set_option :
      context -> key -> option value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_raw_protocol_alpha.Raw_context.t * Z * bool)).
    
    Parameter delete :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_raw_protocol_alpha.Raw_context.t * Z)).
    
    Parameter remove :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_raw_protocol_alpha.Raw_context.t * Z * bool)).
  End Code.
  
  Module Storage.
    Definition context := Tezos_raw_protocol_alpha.Raw_context.t.
    
    Definition key := Tezos_raw_protocol_alpha.Contract_repr.t.
    
    Definition value := Tezos_raw_protocol_alpha.Script_repr.lazy_expr.
    
    Parameter mem :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_raw_protocol_alpha.Raw_context.t * bool)).
    
    Parameter get :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_raw_protocol_alpha.Raw_context.t * value)).
    
    Parameter get_option :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_raw_protocol_alpha.Raw_context.t * option value)).
    
    Parameter set :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_raw_protocol_alpha.Raw_context.t * Z)).
    
    Parameter init :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_raw_protocol_alpha.Raw_context.t * Z)).
    
    Parameter init_set :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_raw_protocol_alpha.Raw_context.t * Z * bool)).
    
    Parameter set_option :
      context -> key -> option value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_raw_protocol_alpha.Raw_context.t * Z * bool)).
    
    Parameter delete :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_raw_protocol_alpha.Raw_context.t * Z)).
    
    Parameter remove :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_raw_protocol_alpha.Raw_context.t * Z * bool)).
  End Storage.
  
  Module Used_storage_space.
    Definition context := Tezos_raw_protocol_alpha.Raw_context.t.
    
    Definition key := Tezos_raw_protocol_alpha.Contract_repr.t.
    
    Definition value := Tezos_protocol_environment_alpha__Environment.Z.t.
    
    Parameter mem :
      context -> key -> Tezos_protocol_environment_alpha__Environment.Lwt.t bool.
    
    Parameter get :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          value).
    
    Parameter get_option :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (option value)).
    
    Parameter set :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter init :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter init_set :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter set_option :
      context -> key -> option value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter delete :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter remove :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter clear :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter keys :
      context -> Tezos_protocol_environment_alpha__Environment.Lwt.t (list key).
    
    Parameter bindings :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t (list (key * value)).
    
    Parameter fold : forall {a : Set},
      context -> a ->
      (key -> value -> a ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a.
    
    Parameter fold_keys : forall {a : Set},
      context -> a ->
      (key -> a -> Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a.
  End Used_storage_space.
  
  Module Paid_storage_space.
    Definition context := Tezos_raw_protocol_alpha.Raw_context.t.
    
    Definition key := Tezos_raw_protocol_alpha.Contract_repr.t.
    
    Definition value := Tezos_protocol_environment_alpha__Environment.Z.t.
    
    Parameter mem :
      context -> key -> Tezos_protocol_environment_alpha__Environment.Lwt.t bool.
    
    Parameter get :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          value).
    
    Parameter get_option :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (option value)).
    
    Parameter set :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter init :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter init_set :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter set_option :
      context -> key -> option value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter delete :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter remove :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter clear :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter keys :
      context -> Tezos_protocol_environment_alpha__Environment.Lwt.t (list key).
    
    Parameter bindings :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t (list (key * value)).
    
    Parameter fold : forall {a : Set},
      context -> a ->
      (key -> value -> a ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a.
    
    Parameter fold_keys : forall {a : Set},
      context -> a ->
      (key -> a -> Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a.
  End Paid_storage_space.
End Contract.

Module Big_map.
  Module Next.
    Parameter incr :
      Tezos_raw_protocol_alpha.Raw_context.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_raw_protocol_alpha.Raw_context.t *
            Tezos_protocol_environment_alpha__Environment.Z.t)).
    
    Parameter init :
      Tezos_raw_protocol_alpha.Raw_context.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
  End Next.
  
  Parameter fold : forall {a : Set},
    Tezos_raw_protocol_alpha.Raw_context.t -> a ->
    (Tezos_protocol_environment_alpha__Environment.Z.t -> a ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t a.
  
  Parameter __list_value :
    Tezos_raw_protocol_alpha.Raw_context.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (list Tezos_protocol_environment_alpha__Environment.Z.t).
  
  Parameter remove_rec :
    Tezos_raw_protocol_alpha.Raw_context.t ->
    Tezos_protocol_environment_alpha__Environment.Z.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      Tezos_raw_protocol_alpha.Raw_context.t.
  
  Parameter copy :
    Tezos_raw_protocol_alpha.Raw_context.t ->
    Tezos_protocol_environment_alpha__Environment.Z.t ->
    Tezos_protocol_environment_alpha__Environment.Z.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        Tezos_raw_protocol_alpha.Raw_context.t).
  
  Definition key :=
    Tezos_raw_protocol_alpha.Raw_context.t *
      Tezos_protocol_environment_alpha__Environment.Z.t.
  
  Parameter rpc_arg :
    Tezos_protocol_environment_alpha__Environment.RPC_arg.t
      Tezos_protocol_environment_alpha__Environment.Z.t.
  
  Module Contents.
    Definition context := key.
    
    Definition key := Tezos_raw_protocol_alpha.Script_expr_hash.t.
    
    Definition value := Tezos_raw_protocol_alpha.Script_repr.expr.
    
    Parameter mem :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_raw_protocol_alpha.Raw_context.t * bool)).
    
    Parameter get :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_raw_protocol_alpha.Raw_context.t * value)).
    
    Parameter get_option :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_raw_protocol_alpha.Raw_context.t * option value)).
    
    Parameter set :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_raw_protocol_alpha.Raw_context.t * Z)).
    
    Parameter init :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_raw_protocol_alpha.Raw_context.t * Z)).
    
    Parameter init_set :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_raw_protocol_alpha.Raw_context.t * Z * bool)).
    
    Parameter set_option :
      context -> key -> option value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_raw_protocol_alpha.Raw_context.t * Z * bool)).
    
    Parameter delete :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_raw_protocol_alpha.Raw_context.t * Z)).
    
    Parameter remove :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_raw_protocol_alpha.Raw_context.t * Z * bool)).
  End Contents.
  
  Module Total_bytes.
    Definition context := Tezos_raw_protocol_alpha.Raw_context.t.
    
    Definition key := Tezos_protocol_environment_alpha__Environment.Z.t.
    
    Definition value := Tezos_protocol_environment_alpha__Environment.Z.t.
    
    Parameter mem :
      context -> key -> Tezos_protocol_environment_alpha__Environment.Lwt.t bool.
    
    Parameter get :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          value).
    
    Parameter get_option :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (option value)).
    
    Parameter set :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter init :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter init_set :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter set_option :
      context -> key -> option value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter delete :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter remove :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter clear :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter keys :
      context -> Tezos_protocol_environment_alpha__Environment.Lwt.t (list key).
    
    Parameter bindings :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t (list (key * value)).
    
    Parameter fold : forall {a : Set},
      context -> a ->
      (key -> value -> a ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a.
    
    Parameter fold_keys : forall {a : Set},
      context -> a ->
      (key -> a -> Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a.
  End Total_bytes.
  
  Module Key_type.
    Definition context := Tezos_raw_protocol_alpha.Raw_context.t.
    
    Definition key := Tezos_protocol_environment_alpha__Environment.Z.t.
    
    Definition value := Tezos_raw_protocol_alpha.Script_repr.expr.
    
    Parameter mem :
      context -> key -> Tezos_protocol_environment_alpha__Environment.Lwt.t bool.
    
    Parameter get :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          value).
    
    Parameter get_option :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (option value)).
    
    Parameter set :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter init :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter init_set :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter set_option :
      context -> key -> option value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter delete :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter remove :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter clear :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter keys :
      context -> Tezos_protocol_environment_alpha__Environment.Lwt.t (list key).
    
    Parameter bindings :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t (list (key * value)).
    
    Parameter fold : forall {a : Set},
      context -> a ->
      (key -> value -> a ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a.
    
    Parameter fold_keys : forall {a : Set},
      context -> a ->
      (key -> a -> Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a.
  End Key_type.
  
  Module Value_type.
    Definition context := Tezos_raw_protocol_alpha.Raw_context.t.
    
    Definition key := Tezos_protocol_environment_alpha__Environment.Z.t.
    
    Definition value := Tezos_raw_protocol_alpha.Script_repr.expr.
    
    Parameter mem :
      context -> key -> Tezos_protocol_environment_alpha__Environment.Lwt.t bool.
    
    Parameter get :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          value).
    
    Parameter get_option :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (option value)).
    
    Parameter set :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter init :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter init_set :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter set_option :
      context -> key -> option value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter delete :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter remove :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter clear :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter keys :
      context -> Tezos_protocol_environment_alpha__Environment.Lwt.t (list key).
    
    Parameter bindings :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t (list (key * value)).
    
    Parameter fold : forall {a : Set},
      context -> a ->
      (key -> value -> a ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a.
    
    Parameter fold_keys : forall {a : Set},
      context -> a ->
      (key -> a -> Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a.
  End Value_type.
End Big_map.

Module Delegates.
  Definition context := Tezos_raw_protocol_alpha.Raw_context.t.
  
  Definition elt :=
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t.
  
  Parameter mem :
    context -> elt -> Tezos_protocol_environment_alpha__Environment.Lwt.t bool.
  
  Parameter add :
    context -> elt ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      Tezos_raw_protocol_alpha.Raw_context.t.
  
  Parameter del :
    context -> elt ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      Tezos_raw_protocol_alpha.Raw_context.t.
  
  Parameter set :
    context -> elt -> bool ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      Tezos_raw_protocol_alpha.Raw_context.t.
  
  Parameter elements :
    context -> Tezos_protocol_environment_alpha__Environment.Lwt.t (list elt).
  
  Parameter fold : forall {a : Set},
    context -> a ->
    (elt -> a -> Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t a.
  
  Parameter clear :
    context ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      Tezos_raw_protocol_alpha.Raw_context.t.
End Delegates.

Module Active_delegates_with_rolls.
  Definition context := Tezos_raw_protocol_alpha.Raw_context.t.
  
  Definition elt :=
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t.
  
  Parameter mem :
    context -> elt -> Tezos_protocol_environment_alpha__Environment.Lwt.t bool.
  
  Parameter add :
    context -> elt ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      Tezos_raw_protocol_alpha.Raw_context.t.
  
  Parameter del :
    context -> elt ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      Tezos_raw_protocol_alpha.Raw_context.t.
  
  Parameter set :
    context -> elt -> bool ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      Tezos_raw_protocol_alpha.Raw_context.t.
  
  Parameter elements :
    context -> Tezos_protocol_environment_alpha__Environment.Lwt.t (list elt).
  
  Parameter fold : forall {a : Set},
    context -> a ->
    (elt -> a -> Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t a.
  
  Parameter clear :
    context ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      Tezos_raw_protocol_alpha.Raw_context.t.
End Active_delegates_with_rolls.

Module Delegates_with_frozen_balance.
  Definition t :=
    Tezos_raw_protocol_alpha.Raw_context.t *
      Tezos_raw_protocol_alpha.Cycle_repr.t.
  
  Definition context := t.
  
  Definition elt :=
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t.
  
  Parameter mem :
    context -> elt -> Tezos_protocol_environment_alpha__Environment.Lwt.t bool.
  
  Parameter add :
    context -> elt ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      Tezos_raw_protocol_alpha.Raw_context.t.
  
  Parameter del :
    context -> elt ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      Tezos_raw_protocol_alpha.Raw_context.t.
  
  Parameter set :
    context -> elt -> bool ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      Tezos_raw_protocol_alpha.Raw_context.t.
  
  Parameter elements :
    context -> Tezos_protocol_environment_alpha__Environment.Lwt.t (list elt).
  
  Parameter fold : forall {a : Set},
    context -> a ->
    (elt -> a -> Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t a.
  
  Parameter clear :
    context ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      Tezos_raw_protocol_alpha.Raw_context.t.
End Delegates_with_frozen_balance.

Module Vote.
  Module Current_period_kind.
    Definition context := Tezos_raw_protocol_alpha.Raw_context.t.
    
    Definition value := Tezos_raw_protocol_alpha.Voting_period_repr.kind.
    
    Parameter mem :
      context -> Tezos_protocol_environment_alpha__Environment.Lwt.t bool.
    
    Parameter get :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          value).
    
    Parameter get_option :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (option value)).
    
    Parameter init :
      context -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter set :
      context -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter init_set :
      context -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter set_option :
      context -> option value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter delete :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter remove :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
  End Current_period_kind.
  
  Module Participation_ema.
    Definition context := Tezos_raw_protocol_alpha.Raw_context.t.
    
    Definition value := int32.
    
    Parameter mem :
      context -> Tezos_protocol_environment_alpha__Environment.Lwt.t bool.
    
    Parameter get :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          value).
    
    Parameter get_option :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (option value)).
    
    Parameter init :
      context -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter set :
      context -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter init_set :
      context -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter set_option :
      context -> option value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter delete :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter remove :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
  End Participation_ema.
  
  Module Current_proposal.
    Definition context := Tezos_raw_protocol_alpha.Raw_context.t.
    
    Definition value :=
      Tezos_protocol_environment_alpha__Environment.Protocol_hash.t.
    
    Parameter mem :
      context -> Tezos_protocol_environment_alpha__Environment.Lwt.t bool.
    
    Parameter get :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          value).
    
    Parameter get_option :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (option value)).
    
    Parameter init :
      context -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter set :
      context -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter init_set :
      context -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter set_option :
      context -> option value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter delete :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter remove :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
  End Current_proposal.
  
  Module Listings_size.
    Definition context := Tezos_raw_protocol_alpha.Raw_context.t.
    
    Definition value := int32.
    
    Parameter mem :
      context -> Tezos_protocol_environment_alpha__Environment.Lwt.t bool.
    
    Parameter get :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          value).
    
    Parameter get_option :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (option value)).
    
    Parameter init :
      context -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter set :
      context -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter init_set :
      context -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter set_option :
      context -> option value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter delete :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter remove :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
  End Listings_size.
  
  Module Listings.
    Definition context := Tezos_raw_protocol_alpha.Raw_context.t.
    
    Definition key :=
      Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t.
    
    Definition value := int32.
    
    Parameter mem :
      context -> key -> Tezos_protocol_environment_alpha__Environment.Lwt.t bool.
    
    Parameter get :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          value).
    
    Parameter get_option :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (option value)).
    
    Parameter set :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter init :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter init_set :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter set_option :
      context -> key -> option value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter delete :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter remove :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter clear :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter keys :
      context -> Tezos_protocol_environment_alpha__Environment.Lwt.t (list key).
    
    Parameter bindings :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t (list (key * value)).
    
    Parameter fold : forall {a : Set},
      context -> a ->
      (key -> value -> a ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a.
    
    Parameter fold_keys : forall {a : Set},
      context -> a ->
      (key -> a -> Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a.
  End Listings.
  
  Module Proposals.
    Definition context := Tezos_raw_protocol_alpha.Raw_context.t.
    
    Definition elt :=
      Tezos_protocol_environment_alpha__Environment.Protocol_hash.t *
        Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t.
    
    Parameter mem :
      context -> elt -> Tezos_protocol_environment_alpha__Environment.Lwt.t bool.
    
    Parameter add :
      context -> elt ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter del :
      context -> elt ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter set :
      context -> elt -> bool ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter elements :
      context -> Tezos_protocol_environment_alpha__Environment.Lwt.t (list elt).
    
    Parameter fold : forall {a : Set},
      context -> a ->
      (elt -> a -> Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a.
    
    Parameter clear :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
  End Proposals.
  
  Module Proposals_count.
    Definition context := Tezos_raw_protocol_alpha.Raw_context.t.
    
    Definition key :=
      Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t.
    
    Definition value := Z.
    
    Parameter mem :
      context -> key -> Tezos_protocol_environment_alpha__Environment.Lwt.t bool.
    
    Parameter get :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          value).
    
    Parameter get_option :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (option value)).
    
    Parameter set :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter init :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter init_set :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter set_option :
      context -> key -> option value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter delete :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter remove :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter clear :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter keys :
      context -> Tezos_protocol_environment_alpha__Environment.Lwt.t (list key).
    
    Parameter bindings :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t (list (key * value)).
    
    Parameter fold : forall {a : Set},
      context -> a ->
      (key -> value -> a ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a.
    
    Parameter fold_keys : forall {a : Set},
      context -> a ->
      (key -> a -> Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a.
  End Proposals_count.
  
  Module Ballots.
    Definition context := Tezos_raw_protocol_alpha.Raw_context.t.
    
    Definition key :=
      Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t.
    
    Definition value := Tezos_raw_protocol_alpha.Vote_repr.ballot.
    
    Parameter mem :
      context -> key -> Tezos_protocol_environment_alpha__Environment.Lwt.t bool.
    
    Parameter get :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          value).
    
    Parameter get_option :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (option value)).
    
    Parameter set :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter init :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter init_set :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter set_option :
      context -> key -> option value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter delete :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter remove :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter clear :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter keys :
      context -> Tezos_protocol_environment_alpha__Environment.Lwt.t (list key).
    
    Parameter bindings :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t (list (key * value)).
    
    Parameter fold : forall {a : Set},
      context -> a ->
      (key -> value -> a ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a.
    
    Parameter fold_keys : forall {a : Set},
      context -> a ->
      (key -> a -> Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a.
  End Ballots.
End Vote.

Module Seed.
  Module unrevealed_nonce.
    Record record := {
      nonce_hash : Tezos_raw_protocol_alpha.Nonce_hash.t;
      delegate :
        Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t;
      rewards : Tezos_raw_protocol_alpha.Tez_repr.t;
      fees : Tezos_raw_protocol_alpha.Tez_repr.t }.
  End unrevealed_nonce.
  Definition unrevealed_nonce := unrevealed_nonce.record.
  
  Inductive nonce_status : Set :=
  | Unrevealed : unrevealed_nonce -> nonce_status
  | Revealed : Tezos_raw_protocol_alpha.Seed_repr.nonce -> nonce_status.
  
  Module Nonce.
    Definition context := Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter mem :
      context -> Tezos_raw_protocol_alpha.Level_repr.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t bool.
    
    Parameter get :
      context -> Tezos_raw_protocol_alpha.Level_repr.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          nonce_status).
    
    Parameter get_option :
      context -> Tezos_raw_protocol_alpha.Level_repr.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (option nonce_status)).
    
    Parameter set :
      context -> Tezos_raw_protocol_alpha.Level_repr.t -> nonce_status ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter init :
      context -> Tezos_raw_protocol_alpha.Level_repr.t -> nonce_status ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter init_set :
      context -> Tezos_raw_protocol_alpha.Level_repr.t -> nonce_status ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter set_option :
      context -> Tezos_raw_protocol_alpha.Level_repr.t -> option nonce_status ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter delete :
      context -> Tezos_raw_protocol_alpha.Level_repr.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter remove :
      context -> Tezos_raw_protocol_alpha.Level_repr.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
  End Nonce.
  
  Module For_cycle.
    Parameter init :
      Tezos_raw_protocol_alpha.Raw_context.t ->
      Tezos_raw_protocol_alpha.Cycle_repr.t ->
      Tezos_raw_protocol_alpha.Seed_repr.seed ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter get :
      Tezos_raw_protocol_alpha.Raw_context.t ->
      Tezos_raw_protocol_alpha.Cycle_repr.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Seed_repr.seed).
    
    Parameter delete :
      Tezos_raw_protocol_alpha.Raw_context.t ->
      Tezos_raw_protocol_alpha.Cycle_repr.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
  End For_cycle.
End Seed.

Module Commitments.
  Definition context := Tezos_raw_protocol_alpha.Raw_context.t.
  
  Definition key := Tezos_raw_protocol_alpha.Blinded_public_key_hash.t.
  
  Definition value := Tezos_raw_protocol_alpha.Tez_repr.t.
  
  Parameter mem :
    context -> key -> Tezos_protocol_environment_alpha__Environment.Lwt.t bool.
  
  Parameter get :
    context -> key ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult value).
  
  Parameter get_option :
    context -> key ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (option value)).
  
  Parameter set :
    context -> key -> value ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        Tezos_raw_protocol_alpha.Raw_context.t).
  
  Parameter init :
    context -> key -> value ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        Tezos_raw_protocol_alpha.Raw_context.t).
  
  Parameter init_set :
    context -> key -> value ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      Tezos_raw_protocol_alpha.Raw_context.t.
  
  Parameter set_option :
    context -> key -> option value ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      Tezos_raw_protocol_alpha.Raw_context.t.
  
  Parameter delete :
    context -> key ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        Tezos_raw_protocol_alpha.Raw_context.t).
  
  Parameter remove :
    context -> key ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      Tezos_raw_protocol_alpha.Raw_context.t.
  
  Parameter clear :
    context ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      Tezos_raw_protocol_alpha.Raw_context.t.
  
  Parameter keys :
    context -> Tezos_protocol_environment_alpha__Environment.Lwt.t (list key).
  
  Parameter bindings :
    context ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t (list (key * value)).
  
  Parameter fold : forall {a : Set},
    context -> a ->
    (key -> value -> a -> Tezos_protocol_environment_alpha__Environment.Lwt.t a)
    -> Tezos_protocol_environment_alpha__Environment.Lwt.t a.
  
  Parameter fold_keys : forall {a : Set},
    context -> a ->
    (key -> a -> Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t a.
End Commitments.

Module Ramp_up.
  Module Rewards.
    Definition context := Tezos_raw_protocol_alpha.Raw_context.t.
    
    Definition key := Tezos_raw_protocol_alpha.Cycle_repr.t.
    
    Definition value :=
      Tezos_raw_protocol_alpha.Tez_repr.t * Tezos_raw_protocol_alpha.Tez_repr.t.
    
    Parameter mem :
      context -> key -> Tezos_protocol_environment_alpha__Environment.Lwt.t bool.
    
    Parameter get :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          value).
    
    Parameter get_option :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (option value)).
    
    Parameter set :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter init :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter init_set :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter set_option :
      context -> key -> option value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter delete :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter remove :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter clear :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter keys :
      context -> Tezos_protocol_environment_alpha__Environment.Lwt.t (list key).
    
    Parameter bindings :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t (list (key * value)).
    
    Parameter fold : forall {a : Set},
      context -> a ->
      (key -> value -> a ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a.
    
    Parameter fold_keys : forall {a : Set},
      context -> a ->
      (key -> a -> Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a.
  End Rewards.
  
  Module Security_deposits.
    Definition context := Tezos_raw_protocol_alpha.Raw_context.t.
    
    Definition key := Tezos_raw_protocol_alpha.Cycle_repr.t.
    
    Definition value :=
      Tezos_raw_protocol_alpha.Tez_repr.t * Tezos_raw_protocol_alpha.Tez_repr.t.
    
    Parameter mem :
      context -> key -> Tezos_protocol_environment_alpha__Environment.Lwt.t bool.
    
    Parameter get :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          value).
    
    Parameter get_option :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (option value)).
    
    Parameter set :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter init :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter init_set :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter set_option :
      context -> key -> option value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter delete :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter remove :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter clear :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
    
    Parameter keys :
      context -> Tezos_protocol_environment_alpha__Environment.Lwt.t (list key).
    
    Parameter bindings :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t (list (key * value)).
    
    Parameter fold : forall {a : Set},
      context -> a ->
      (key -> value -> a ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a.
    
    Parameter fold_keys : forall {a : Set},
      context -> a ->
      (key -> a -> Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a.
  End Security_deposits.
End Ramp_up.

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

module StringMap = Map.Make (String)

type 'key t = 'key description ref

and 'key description =
  | Empty : 'key description
  | Value : {
      get : 'key -> 'a option tzresult Lwt.t;
      encoding : 'a Data_encoding.t;
    }
      -> 'key description
  | NamedDir : 'key t StringMap.t -> 'key description
  | IndexedDir : {
      arg : 'a RPC_arg.t;
      arg_encoding : 'a Data_encoding.t;
      list : 'key -> 'a list tzresult Lwt.t;
      subdir : ('key * 'a) t;
    }
      -> 'key description

let rec register_named_subcontext : type r. r t -> string list -> r t =
 fun dir names ->
  match (!dir, names) with
  | (_, []) ->
      dir
  | (Value _, _) ->
      invalid_arg ""
  | (IndexedDir _, _) ->
      invalid_arg ""
  | (Empty, name :: names) ->
      let subdir = ref Empty in
      dir := NamedDir (StringMap.singleton name subdir) ;
      register_named_subcontext subdir names
  | (NamedDir map, name :: names) ->
      let subdir =
        match StringMap.find_opt name map with
        | Some subdir ->
            subdir
        | None ->
            let subdir = ref Empty in
            dir := NamedDir (StringMap.add name subdir map) ;
            subdir
      in
      register_named_subcontext subdir names

type (_, _, _) args =
  | One : {
      rpc_arg : 'a RPC_arg.t;
      encoding : 'a Data_encoding.t;
      compare : 'a -> 'a -> int;
    }
      -> ('key, 'a, 'key * 'a) args
  | Pair :
      ('key, 'a, 'inter_key) args * ('inter_key, 'b, 'sub_key) args
      -> ('key, 'a * 'b, 'sub_key) args

let rec unpack : type a b c. (a, b, c) args -> c -> a * b = function
  | One _ ->
      fun x -> x
  | Pair (l, r) ->
      let unpack_l = unpack l in
      let unpack_r = unpack r in
      fun x ->
        let (c, d) = unpack_r x in
        let (b, a) = unpack_l c in
        (b, (a, d))

let rec pack : type a b c. (a, b, c) args -> a -> b -> c = function
  | One _ ->
      fun b a -> (b, a)
  | Pair (l, r) ->
      let pack_l = pack l in
      let pack_r = pack r in
      fun b (a, d) ->
        let c = pack_l b a in
        pack_r c d

let rec compare : type a b c. (a, b, c) args -> b -> b -> int = function
  | One {compare; _} ->
      compare
  | Pair (l, r) -> (
      let compare_l = compare l in
      let compare_r = compare r in
      fun (a1, b1) (a2, b2) ->
        match compare_l a1 a2 with 0 -> compare_r b1 b2 | x -> x )

let destutter equal l =
  match l with
  | [] ->
      []
  | (i, _) :: l ->
      let rec loop acc i = function
        | [] ->
            acc
        | (j, _) :: l ->
            if equal i j then loop acc i l else loop (j :: acc) j l
      in
      loop [i] i l

let rec register_indexed_subcontext :
    type r a b.
    r t -> list:(r -> a list tzresult Lwt.t) -> (r, a, b) args -> b t =
 fun dir ~list path ->
  match path with
  | Pair (left, right) ->
      let compare_left = compare left in
      let equal_left x y = Compare.Int.(compare_left x y = 0) in
      let list_left r = list r >>=? fun l -> return (destutter equal_left l) in
      let list_right r =
        let (a, k) = unpack left r in
        list a
        >>=? fun l ->
        return (List.map snd (List.filter (fun (x, _) -> equal_left x k) l))
      in
      register_indexed_subcontext
        (register_indexed_subcontext dir ~list:list_left left)
        ~list:list_right
        right
  | One {rpc_arg = arg; encoding = arg_encoding; _} -> (
    match !dir with
    | Value _ ->
        invalid_arg ""
    | NamedDir _ ->
        invalid_arg ""
    | Empty ->
        let subdir = ref Empty in
        dir := IndexedDir {arg; arg_encoding; list; subdir} ;
        subdir
    | IndexedDir {arg = inner_arg; subdir; _} -> (
      match RPC_arg.eq arg inner_arg with
      | None ->
          invalid_arg ""
      | Some RPC_arg.Eq ->
          subdir ) )

let register_value :
    type a b.
    a t -> get:(a -> b option tzresult Lwt.t) -> b Data_encoding.t -> unit =
 fun dir ~get encoding ->
  match !dir with Empty -> dir := Value {get; encoding} | _ -> invalid_arg ""

let create () = ref Empty

let rec pp : type a. Format.formatter -> a t -> unit =
 fun ppf dir ->
  match !dir with
  | Empty ->
      Format.fprintf ppf "EMPTY"
  | Value _e ->
      Format.fprintf ppf "Value"
  | NamedDir map ->
      Format.fprintf
        ppf
        "@[<v>%a@]"
        (Format.pp_print_list pp_item)
        (StringMap.bindings map)
  | IndexedDir {arg; subdir; _} ->
      let name = Format.asprintf "<%s>" (RPC_arg.descr arg).name in
      pp_item ppf (name, subdir)

and pp_item : type a. Format.formatter -> string * a t -> unit =
 fun ppf (name, dir) -> Format.fprintf ppf "@[<v 2>%s@ %a@]" name pp dir

module type INDEX = sig
  type t

  val path_length : int

  val to_path : t -> string list -> string list

  val of_path : string list -> t option

  val rpc_arg : t RPC_arg.t

  val encoding : t Data_encoding.t

  val compare : t -> t -> int
end

type _ handler =
  | Handler : {
      encoding : 'a Data_encoding.t;
      get : 'key -> int -> 'a tzresult Lwt.t;
    }
      -> 'key handler

type _ opt_handler =
  | Opt_handler : {
      encoding : 'a Data_encoding.t;
      get : 'key -> int -> 'a option tzresult Lwt.t;
    }
      -> 'key opt_handler

let rec combine_object = function
  | [] ->
      Handler {encoding = Data_encoding.unit; get = (fun _ _ -> return_unit)}
  | (name, Opt_handler handler) :: fields ->
      let (Handler handlers) = combine_object fields in
      Handler
        {
          encoding =
            Data_encoding.merge_objs
              Data_encoding.(obj1 (opt name (dynamic_size handler.encoding)))
              handlers.encoding;
          get =
            (fun k i ->
              handler.get k i
              >>=? fun v1 -> handlers.get k i >>=? fun v2 -> return (v1, v2));
        }

type query = {depth : int}

let depth_query =
  let open RPC_query in
  query (fun depth -> {depth})
  |+ field "depth" RPC_arg.int 0 (fun t -> t.depth)
  |> seal

let build_directory : type key. key t -> key RPC_directory.t =
 fun dir ->
  let rpc_dir = ref (RPC_directory.empty : key RPC_directory.t) in
  let register : type ikey. (key, ikey) RPC_path.t -> ikey opt_handler -> unit
      =
   fun path (Opt_handler {encoding; get}) ->
    let service =
      RPC_service.get_service ~query:depth_query ~output:encoding path
    in
    rpc_dir :=
      RPC_directory.register !rpc_dir service (fun k q () ->
          get k (q.depth + 1)
          >>=? function None -> raise Not_found | Some x -> return x)
  in
  let rec build_handler :
      type ikey. ikey t -> (key, ikey) RPC_path.t -> ikey opt_handler =
   fun dir path ->
    match !dir with
    | Empty ->
        Opt_handler
          {encoding = Data_encoding.unit; get = (fun _ _ -> return_none)}
    | Value {get; encoding} ->
        let handler =
          Opt_handler
            {
              encoding;
              get =
                (fun k i -> if Compare.Int.(i < 0) then return_none else get k);
            }
        in
        register path handler ; handler
    | NamedDir map ->
        let fields = StringMap.bindings map in
        let fields =
          List.map
            (fun (name, dir) ->
              (name, build_handler dir RPC_path.(path / name)))
            fields
        in
        let (Handler handler) = combine_object fields in
        let handler =
          Opt_handler
            {
              encoding = handler.encoding;
              get =
                (fun k i ->
                  if Compare.Int.(i < 0) then return_none
                  else handler.get k (i - 1) >>=? fun v -> return_some v);
            }
        in
        register path handler ; handler
    | IndexedDir {arg; arg_encoding; list; subdir} ->
        let (Opt_handler handler) =
          build_handler subdir RPC_path.(path /: arg)
        in
        let encoding =
          let open Data_encoding in
          union
            [ case
                (Tag 0)
                ~title:"Leaf"
                (dynamic_size arg_encoding)
                (function (key, None) -> Some key | _ -> None)
                (fun key -> (key, None));
              case
                (Tag 1)
                ~title:"Dir"
                (tup2
                   (dynamic_size arg_encoding)
                   (dynamic_size handler.encoding))
                (function (key, Some value) -> Some (key, value) | _ -> None)
                (fun (key, value) -> (key, Some value)) ]
        in
        let get k i =
          if Compare.Int.(i < 0) then return_none
          else if Compare.Int.(i = 0) then return_some []
          else
            list k
            >>=? fun keys ->
            map_s
              (fun key ->
                if Compare.Int.(i = 1) then return (key, None)
                else
                  handler.get (k, key) (i - 1)
                  >>=? fun value -> return (key, value))
              keys
            >>=? fun values -> return_some values
        in
        let handler =
          Opt_handler
            {encoding = Data_encoding.(list (dynamic_size encoding)); get}
        in
        register path handler ; handler
  in
  ignore (build_handler dir RPC_path.open_root : key opt_handler) ;
  !rpc_dir

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

(* ❌ Applications of functors are not handled. *)
functor_application

Reserved Notation "'t".
Reserved Notation "'description".

Inductive description_gadt : Set :=
| Empty : description_gadt
| Value : forall {a key : Set},
  (key ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (option a))) ->
  Tezos_protocol_environment_alpha__Environment.Data_encoding.t a ->
  description_gadt
| NamedDir : forall {key : Set}, StringMap.t ('t key) -> description_gadt
| IndexedDir : forall {a key : Set},
  Tezos_protocol_environment_alpha__Environment.RPC_arg.t a ->
  Tezos_protocol_environment_alpha__Environment.Data_encoding.t a ->
  (key ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult (list a)))
  -> 't (key * a) -> description_gadt

where "'t" := (fun (key : Set) =>
  Tezos_protocol_environment_alpha__Environment.Pervasives.ref
    ('description key))
and "'description" := (fun (key : Set) => description_gadt).

Definition t := 't.
Definition description := 'description.

Fixpoint register_named_subcontext {r : Set} (dir : t r) (names : list string)
  : t r :=
  match ((op_exclamation dir), names) with
  | (_, []) => dir
  | (Value _, _) => invalid_arg "" % string
  | (IndexedDir _, _) => invalid_arg "" % string
  | (Empty, cons name names) =>
    let subdir := __ref_value Empty in
    (* ❌ Sequences of instructions are not handled (operator ";") *)
    let _ := op_coloneq dir (NamedDir (StringMap.singleton name subdir)) in
    register_named_subcontext subdir names
  | (NamedDir map, cons name names) =>
    let subdir :=
      match StringMap.find_opt name map with
      | Some subdir => subdir
      | None =>
        let subdir := __ref_value Empty in
        (* ❌ Sequences of instructions are not handled (operator ";") *)
        let _ := op_coloneq dir (NamedDir (StringMap.add name subdir map)) in
        subdir
      end in
    register_named_subcontext subdir names
  end.

Reserved Notation "'args".

Inductive args_gadt : Set :=
| One : forall {a : Set},
  Tezos_protocol_environment_alpha__Environment.RPC_arg.t a ->
  Tezos_protocol_environment_alpha__Environment.Data_encoding.t a ->
  (a -> a -> Z) -> args_gadt
| Pair : args_gadt -> args_gadt -> args_gadt

where "'args" := (fun (_ _ _ : Set) => args_gadt).

Definition args := 'args.

Fixpoint unpack {a b c : Set} (function_parameter : args a b c) : c -> a * b :=
  match function_parameter with
  | One _ => fun x => x
  | Pair l r =>
    let unpack_l := unpack l in
    let unpack_r := unpack r in
    fun x =>
      let '(c, d) := unpack_r x in
      let '(b, a) := unpack_l c in
      (b, (a, d))
  end.

Fixpoint pack {a b c : Set} (function_parameter : args a b c) : a -> b -> c :=
  match function_parameter with
  | One _ => fun b => fun a => (b, a)
  | Pair l r =>
    let pack_l := pack l in
    let pack_r := pack r in
    fun b =>
      fun function_parameter =>
        let '(a, d) := function_parameter in
        let c := pack_l b a in
        pack_r c d
  end.

Fixpoint compare {a b c : Set} (function_parameter : args a b c)
  : b -> b -> Z :=
  match function_parameter with
  | One {| args.One.compare := compare |} => compare
  | Pair l r =>
    let compare_l := compare l in
    let compare_r := compare r in
    fun function_parameter =>
      let '(a1, b1) := function_parameter in
      fun function_parameter =>
        let '(a2, b2) := function_parameter in
        match compare_l a1 a2 with
        | 0 => compare_r b1 b2
        | x => x
        end
  end.

Definition destutter {A B : Set} (equal : A -> A -> bool) (l : list (A * B))
  : list A :=
  match l with
  | [] => []
  | cons (i, _) l =>
    let fix loop {C : Set}
      (acc : list A) (i : A) (function_parameter : list (A * C)) : list A :=
      match function_parameter with
      | [] => acc
      | cons (j, _) l =>
        if equal i j then
          loop acc i l
        else
          loop (cons j acc) j l
      end in
    loop (cons i []) i l
  end.

Fixpoint register_indexed_subcontext {a b r : Set}
  (dir : t r)
  (__list_value :
    r ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (list a))) (path : args r a b) : t b :=
  match path with
  | Pair left right =>
    let compare_left := compare left in
    let equal_left (x : op_dollar0) (y : op_dollar0) : bool :=
      op_eq (compare_left x y) 0 in
    let list_left (r : r)
      : Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (list op_dollar0)) :=
      op_gtgteqquestion (__list_value r)
        (fun l => __return (destutter equal_left l)) in
    let list_right (r : op_dollarPair_'inter_key)
      : Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (list op_dollar1)) :=
      let '(a, k) := unpack left r in
      op_gtgteqquestion (__list_value a)
        (fun l =>
          __return
            (List.map snd
              (List.filter
                (fun function_parameter =>
                  let '(x, _) := function_parameter in
                  equal_left x k) l))) in
    register_indexed_subcontext (register_indexed_subcontext dir list_left left)
      list_right right
  | One {| args.One.rpc_arg := arg; args.One.encoding := arg_encoding |} =>
    match op_exclamation dir with
    | Value _ => invalid_arg "" % string
    | NamedDir _ => invalid_arg "" % string
    | Empty =>
      let subdir := __ref_value Empty in
      (* ❌ Sequences of instructions are not handled (operator ";") *)
      let _ :=
        op_coloneq dir
          (IndexedDir
            {| description.IndexedDir.arg := arg;
              description.IndexedDir.arg_encoding := arg_encoding;
              description.IndexedDir.list := __list_value;
              description.IndexedDir.subdir := subdir |}) in
      subdir
    |
      IndexedDir {|
        description.IndexedDir.arg := inner_arg;
          description.IndexedDir.subdir := subdir
          |} =>
      match RPC_arg.__eq_value arg inner_arg with
      | None => invalid_arg "" % string
      | Some Tezos_protocol_environment_alpha__Environment.RPC_arg.Eq => subdir
      end
    end
  end.

Definition register_value {a b : Set}
  (dir : t a)
  (get :
    a ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (option b)))
  (encoding : Tezos_protocol_environment_alpha__Environment.Data_encoding.t b)
  : unit :=
  match op_exclamation dir with
  | Empty =>
    op_coloneq dir
      (Value
        {| description.Value.get := get; description.Value.encoding := encoding
          |})
  | _ => invalid_arg "" % string
  end.

Definition create {A : Set} (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Pervasives.ref (description A) :=
  let 'tt := function_parameter in
  __ref_value Empty.

Fixpoint pp {a : Set}
  (ppf : Tezos_protocol_environment_alpha__Environment.Format.formatter)
  (dir : t a) : unit :=
  match op_exclamation dir with
  | Empty =>
    Format.fprintf ppf
      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
          "EMPTY" % string
          Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
        "EMPTY" % string)
  | Value _e =>
    Format.fprintf ppf
      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
          "Value" % string
          Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
        "Value" % string)
  | NamedDir map =>
    Format.fprintf ppf
      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Formatting_gen
          (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Open_box
            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                "<v>" % string
                Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
              "<v>" % string))
          (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Formatting_lit
              Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Close_box
              Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))
        "@[<v>%a@]" % string) (Format.pp_print_list None pp_item)
      (StringMap.bindings map)
  |
    IndexedDir {|
      description.IndexedDir.arg := arg;
        description.IndexedDir.subdir := subdir
        |} =>
    let name :=
      Format.asprintf
        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
          (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Char_literal
            "<" % char
            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String
              Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Char_literal
                ">" % char
                Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))
          "<%s>" % string)
        (Tezos_protocol_environment_alpha__Environment.RPC_arg.descr.name
          (RPC_arg.__descr_value arg)) in
    pp_item ppf (name, subdir)
  end

with pp_item {a : Set}
  (ppf : Tezos_protocol_environment_alpha__Environment.Format.formatter)
  (function_parameter : string * t a) : unit :=
  let '(name, dir) := function_parameter in
  Format.fprintf ppf
    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Formatting_gen
        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Open_box
          (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
              "<v 2>" % string
              Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
            "<v 2>" % string))
        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String
          Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
          (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Formatting_lit
            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Break
              "@ " % string 1 0)
            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Formatting_lit
                Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Close_box
                Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))))
      "@[<v 2>%s@ %a@]" % string) name pp dir.

Module INDEX.
  Record signature {t : Set} := {
    t := t;
    path_length : Z;
    to_path : t -> list string -> list string;
    of_path : list string -> option t;
    rpc_arg : Tezos_protocol_environment_alpha__Environment.RPC_arg.t t;
    encoding : Tezos_protocol_environment_alpha__Environment.Data_encoding.t t;
    compare : t -> t -> Z;
  }.
  Arguments signature : clear implicits.
End INDEX.

Reserved Notation "'handler".

Inductive handler_gadt : Set :=
| Handler : forall {a key : Set},
  Tezos_protocol_environment_alpha__Environment.Data_encoding.t a ->
  (key -> Z ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult a)) ->
  handler_gadt

where "'handler" := (fun (_ : Set) => handler_gadt).

Definition handler := 'handler.

Reserved Notation "'opt_handler".

Inductive opt_handler_gadt : Set :=
| Opt_handler : forall {a key : Set},
  Tezos_protocol_environment_alpha__Environment.Data_encoding.t a ->
  (key -> Z ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (option a))) -> opt_handler_gadt

where "'opt_handler" := (fun (_ : Set) => opt_handler_gadt).

Definition opt_handler := 'opt_handler.

Fixpoint combine_object {A : Set}
  (function_parameter : list (string * opt_handler A)) : handler A :=
  match function_parameter with
  | [] =>
    Handler
      {| handler.Handler.encoding := Data_encoding.__unit_value;
        handler.Handler.get :=
          fun function_parameter =>
            let '_ := function_parameter in
            fun function_parameter =>
              let '_ := function_parameter in
              return_unit |}
  | cons (name, Opt_handler handler) fields =>
    let 'Handler handlers := combine_object fields in
    Handler
      {|
        handler.Handler.encoding :=
          Data_encoding.merge_objs
            (obj1
              (opt None None name
                (dynamic_size None (opt_handler.Opt_handler.encoding handler))))
            (handler.Handler.encoding handlers);
        handler.Handler.get :=
          fun k =>
            fun i =>
              op_gtgteqquestion ((opt_handler.Opt_handler.get handler) k i)
                (fun v1 =>
                  op_gtgteqquestion ((handler.Handler.get handlers) k i)
                    (fun v2 => __return (v1, v2))) |}
  end.

Module query.
  Record record := {
    depth : Z }.
End query.
Definition query := query.record.

Definition depth_query
  : Tezos_protocol_environment_alpha__Environment.RPC_query.t query :=
  op_pipegt
    (op_pipeplus (__query_value (fun depth => {| query.depth := depth |}))
      (__field_value None "depth" % string RPC_arg.int 0
        (fun t => query.depth t))) seal.

Definition build_directory {key : Set} (dir : t key)
  : Tezos_protocol_environment_alpha__Environment.RPC_directory.t key :=
  let rpc_dir := __ref_value RPC_directory.empty in
  let register {ikey : Set}
    (path : Tezos_protocol_environment_alpha__Environment.RPC_path.t key ikey)
    (function_parameter : opt_handler ikey) : unit :=
    let
      'Opt_handler {|
        opt_handler.Opt_handler.encoding := encoding;
          opt_handler.Opt_handler.get := get
          |} := function_parameter in
    let service := RPC_service.get_service None depth_query encoding path in
    op_coloneq rpc_dir
      (RPC_directory.register (op_exclamation rpc_dir) service
        (fun k =>
          fun q =>
            fun function_parameter =>
              let 'tt := function_parameter in
              op_gtgteqquestion (get k (op_plus (query.depth q) 1))
                (fun function_parameter =>
                  match function_parameter with
                  | None => raise OCaml.Not_found
                  | Some x => __return x
                  end))) in
  let fix build_handler {ikey : Set}
    (dir : t ikey) (path :
    Tezos_protocol_environment_alpha__Environment.RPC_path.t key ikey)
    : opt_handler ikey :=
    match op_exclamation dir with
    | Empty =>
      Opt_handler
        {| opt_handler.Opt_handler.encoding := Data_encoding.__unit_value;
          opt_handler.Opt_handler.get :=
            fun function_parameter =>
              let '_ := function_parameter in
              fun function_parameter =>
                let '_ := function_parameter in
                return_none |}
    |
      Value {|
        description.Value.get := get;
          description.Value.encoding := encoding
          |} =>
      let handler :=
        Opt_handler
          {| opt_handler.Opt_handler.encoding := encoding;
            opt_handler.Opt_handler.get :=
              fun k =>
                fun i =>
                  if op_lt i 0 then
                    return_none
                  else
                    get k |} in
      (* ❌ Sequences of instructions are not handled (operator ";") *)
      let _ := register path handler in
      handler
    | NamedDir map =>
      let fields := StringMap.bindings map in
      let fields :=
        List.map
          (fun function_parameter =>
            let '(name, dir) := function_parameter in
            (name, (build_handler dir (op_div path name)))) fields in
      let 'Handler handler := combine_object fields in
      let handler :=
        Opt_handler
          {|
            opt_handler.Opt_handler.encoding := handler.Handler.encoding handler;
            opt_handler.Opt_handler.get :=
              fun k =>
                fun i =>
                  if op_lt i 0 then
                    return_none
                  else
                    op_gtgteqquestion
                      ((handler.Handler.get handler) k (op_minus i 1))
                      (fun v => return_some v) |} in
      (* ❌ Sequences of instructions are not handled (operator ";") *)
      let _ := register path handler in
      handler
    |
      IndexedDir {|
        description.IndexedDir.arg := arg;
          description.IndexedDir.arg_encoding := arg_encoding;
          description.IndexedDir.list := __list_value;
          description.IndexedDir.subdir := subdir
          |} =>
      let 'Opt_handler handler := build_handler subdir (op_divcolon path arg) in
      let encoding :=
        union None
          (cons
            (__case_value "Leaf" % string None
              (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag 0)
              (dynamic_size None arg_encoding)
              (fun function_parameter =>
                match function_parameter with
                | (key, None) => Some key
                | _ => None
                end) (fun key => (key, None)))
            (cons
              (__case_value "Dir" % string None
                (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag
                  1)
                (tup2 (dynamic_size None arg_encoding)
                  (dynamic_size None (opt_handler.Opt_handler.encoding handler)))
                (fun function_parameter =>
                  match function_parameter with
                  | (key, Some value) => Some (key, value)
                  | _ => None
                  end)
                (fun function_parameter =>
                  let '(key, value) := function_parameter in
                  (key, (Some value)))) [])) in
      let get
        (k : ikey) (i :
        Tezos_protocol_environment_alpha__Environment.Compare.Int.t)
        : Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
            (option
              (list (op_dollarIndexedDir_'a * option op_dollarOpt_handler_'a1)))) :=
        if op_lt i 0 then
          return_none
        else
          if op_eq i 0 then
            return_some []
          else
            op_gtgteqquestion (__list_value k)
              (fun keys =>
                op_gtgteqquestion
                  (map_s
                    (fun key =>
                      if op_eq i 1 then
                        __return (key, None)
                      else
                        op_gtgteqquestion
                          ((opt_handler.Opt_handler.get handler) (k, key)
                            (op_minus i 1)) (fun value => __return (key, value)))
                    keys) (fun values => return_some values)) in
      let handler :=
        Opt_handler
          {|
            opt_handler.Opt_handler.encoding :=
              __list_value None (dynamic_size None encoding);
            opt_handler.Opt_handler.get := get |} in
      (* ❌ Sequences of instructions are not handled (operator ";") *)
      let _ := register path handler in
      handler
    end in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ := ignore (build_handler dir RPC_path.open_root) in
  op_exclamation rpc_dir.

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

(** Typed description of the key-value context. *)
type 'key t

(** Trivial display of the key-value context layout. *)
val pp : Format.formatter -> 'key t -> unit

(** Export an RPC hierarchy for querying the context. There is one service
    by possible path in the context. Services for "directory" are able to
    aggregate in one JSON object the whole subtree. *)
val build_directory : 'key t -> 'key RPC_directory.t

(** Create a empty context description,
    keys will be registred by side effects. *)
val create : unit -> 'key t

(** Register a single key accessor at a given path. *)
val register_value :
  'key t ->
  get:('key -> 'a option tzresult Lwt.t) ->
  'a Data_encoding.t ->
  unit

(** Return a description for a prefixed fragment of the given context.
    All keys registred in the subcontext will be shared by the external
    context *)
val register_named_subcontext : 'key t -> string list -> 'key t

(** Description of an index as a sequence of `RPC_arg.t`. *)
type (_, _, _) args =
  | One : {
      rpc_arg : 'a RPC_arg.t;
      encoding : 'a Data_encoding.t;
      compare : 'a -> 'a -> int;
    }
      -> ('key, 'a, 'key * 'a) args
  | Pair :
      ('key, 'a, 'inter_key) args * ('inter_key, 'b, 'sub_key) args
      -> ('key, 'a * 'b, 'sub_key) args

(** Return a description for a indexed sub-context.
    All keys registred in the subcontext will be shared by the external
    context. One should provide a function to list all the registred
    index in the context. *)
val register_indexed_subcontext :
  'key t ->
  list:('key -> 'arg list tzresult Lwt.t) ->
  ('key, 'arg, 'sub_key) args ->
  'sub_key t

(** Helpers for manipulating and defining indexes. *)

val pack : ('key, 'a, 'sub_key) args -> 'key -> 'a -> 'sub_key

val unpack : ('key, 'a, 'sub_key) args -> 'sub_key -> 'key * 'a

module type INDEX = sig
  type t

  val path_length : int

  val to_path : t -> string list -> string list

  val of_path : string list -> t option

  val rpc_arg : t RPC_arg.t

  val encoding : t Data_encoding.t

  val compare : t -> t -> int
end

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Parameter t : forall (key : Set), Set.

Parameter pp : forall {key : Set},
  Tezos_protocol_environment_alpha__Environment.Format.formatter -> t key ->
  unit.

Parameter build_directory : forall {key : Set},
  t key -> Tezos_protocol_environment_alpha__Environment.RPC_directory.t key.

Parameter create : forall {key : Set}, unit -> t key.

Parameter register_value : forall {a key : Set},
  t key ->
  (key ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (option a))) ->
  Tezos_protocol_environment_alpha__Environment.Data_encoding.t a -> unit.

Parameter register_named_subcontext : forall {key : Set},
  t key -> list string -> t key.

Reserved Notation "'args".

Inductive args_gadt : Set :=
| One : forall {a : Set},
  Tezos_protocol_environment_alpha__Environment.RPC_arg.t a ->
  Tezos_protocol_environment_alpha__Environment.Data_encoding.t a ->
  (a -> a -> Z) -> args_gadt
| Pair : args_gadt -> args_gadt -> args_gadt

where "'args" := (fun (_ _ _ : Set) => args_gadt).

Definition args := 'args.

Parameter register_indexed_subcontext : forall {arg key sub_key : Set},
  t key ->
  (key ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (list arg))) -> args key arg sub_key -> t sub_key.

Parameter pack : forall {a key sub_key : Set},
  args key a sub_key -> key -> a -> sub_key.

Parameter unpack : forall {a key sub_key : Set},
  args key a sub_key -> sub_key -> key * a.

Module INDEX.
  Record signature {t : Set} := {
    t := t;
    path_length : Z;
    to_path : t -> list string -> list string;
    of_path : list string -> option t;
    rpc_arg : Tezos_protocol_environment_alpha__Environment.RPC_arg.t t;
    encoding : Tezos_protocol_environment_alpha__Environment.Data_encoding.t t;
    compare : t -> t -> Z;
  }.
  Arguments signature : clear implicits.
End INDEX.

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Storage_sigs

module Registered = struct
  let ghost = false
end

module Ghost = struct
  let ghost = true
end

module Make_encoder (V : VALUE) = struct
  let of_bytes ~key b =
    match Data_encoding.Binary.of_bytes V.encoding b with
    | None ->
        error (Raw_context.Storage_error (Corrupted_data key))
    | Some v ->
        Ok v

  let to_bytes v =
    match Data_encoding.Binary.to_bytes V.encoding v with
    | Some b ->
        b
    | None ->
        MBytes.create 0
end

let len_name = "len"

let data_name = "data"

let encode_len_value bytes =
  let length = MBytes.length bytes in
  Data_encoding.(Binary.to_bytes_exn int31) length

let decode_len_value key len =
  match Data_encoding.(Binary.of_bytes int31) len with
  | None ->
      fail (Raw_context.Storage_error (Corrupted_data key))
  | Some len ->
      return len

let map_key f = function `Key k -> `Key (f k) | `Dir k -> `Dir (f k)

module Make_subcontext (R : REGISTER) (C : Raw_context.T) (N : NAME) :
  Raw_context.T with type t = C.t = struct
  type t = C.t

  type context = t

  let name_length = List.length N.name

  let to_key k = N.name @ k

  let of_key k = Misc.remove_elem_from_list name_length k

  let mem t k = C.mem t (to_key k)

  let dir_mem t k = C.dir_mem t (to_key k)

  let get t k = C.get t (to_key k)

  let get_option t k = C.get_option t (to_key k)

  let init t k v = C.init t (to_key k) v

  let set t k v = C.set t (to_key k) v

  let init_set t k v = C.init_set t (to_key k) v

  let set_option t k v = C.set_option t (to_key k) v

  let delete t k = C.delete t (to_key k)

  let remove t k = C.remove t (to_key k)

  let remove_rec t k = C.remove_rec t (to_key k)

  let copy t ~from ~to_ = C.copy t ~from:(to_key from) ~to_:(to_key to_)

  let fold t k ~init ~f =
    C.fold t (to_key k) ~init ~f:(fun k acc -> f (map_key of_key k) acc)

  let keys t k = C.keys t (to_key k) >|= fun keys -> List.map of_key keys

  let fold_keys t k ~init ~f =
    C.fold_keys t (to_key k) ~init ~f:(fun k acc -> f (of_key k) acc)

  let project = C.project

  let absolute_key c k = C.absolute_key c (to_key k)

  let consume_gas = C.consume_gas

  let check_enough_gas = C.check_enough_gas

  let description =
    let description =
      if R.ghost then Storage_description.create () else C.description
    in
    Storage_description.register_named_subcontext description N.name
end

module Make_single_data_storage
    (R : REGISTER)
    (C : Raw_context.T)
    (N : NAME)
    (V : VALUE) : Single_data_storage with type t = C.t and type value = V.t =
struct
  type t = C.t

  type context = t

  type value = V.t

  let mem t = C.mem t N.name

  include Make_encoder (V)

  let get t =
    C.get t N.name
    >>=? fun b ->
    let key = C.absolute_key t N.name in
    Lwt.return (of_bytes ~key b)

  let get_option t =
    C.get_option t N.name
    >>= function
    | None ->
        return_none
    | Some b -> (
        let key = C.absolute_key t N.name in
        match of_bytes ~key b with
        | Ok v ->
            return_some v
        | Error _ as err ->
            Lwt.return err )

  let init t v =
    C.init t N.name (to_bytes v) >>=? fun t -> return (C.project t)

  let set t v = C.set t N.name (to_bytes v) >>=? fun t -> return (C.project t)

  let init_set t v =
    C.init_set t N.name (to_bytes v) >>= fun t -> Lwt.return (C.project t)

  let set_option t v =
    C.set_option t N.name (Option.map ~f:to_bytes v)
    >>= fun t -> Lwt.return (C.project t)

  let remove t = C.remove t N.name >>= fun t -> Lwt.return (C.project t)

  let delete t = C.delete t N.name >>=? fun t -> return (C.project t)

  let () =
    let open Storage_description in
    let description =
      if R.ghost then Storage_description.create () else C.description
    in
    register_value
      ~get:get_option
      (register_named_subcontext description N.name)
      V.encoding
end

module type INDEX = sig
  type t

  val path_length : int

  val to_path : t -> string list -> string list

  val of_path : string list -> t option

  type 'a ipath

  val args : ('a, t, 'a ipath) Storage_description.args
end

module Pair (I1 : INDEX) (I2 : INDEX) : INDEX with type t = I1.t * I2.t =
struct
  type t = I1.t * I2.t

  let path_length = I1.path_length + I2.path_length

  let to_path (x, y) l = I1.to_path x (I2.to_path y l)

  let of_path l =
    match Misc.take I1.path_length l with
    | None ->
        None
    | Some (l1, l2) -> (
      match (I1.of_path l1, I2.of_path l2) with
      | (Some x, Some y) ->
          Some (x, y)
      | _ ->
          None )

  type 'a ipath = 'a I1.ipath I2.ipath

  let args = Storage_description.Pair (I1.args, I2.args)
end

module Make_data_set_storage (C : Raw_context.T) (I : INDEX) :
  Data_set_storage with type t = C.t and type elt = I.t = struct
  type t = C.t

  type context = t

  type elt = I.t

  let inited = MBytes.of_string "inited"

  let mem s i = C.mem s (I.to_path i [])

  let add s i =
    C.init_set s (I.to_path i []) inited >>= fun t -> Lwt.return (C.project t)

  let del s i =
    C.remove s (I.to_path i []) >>= fun t -> Lwt.return (C.project t)

  let set s i = function true -> add s i | false -> del s i

  let clear s = C.remove_rec s [] >>= fun t -> Lwt.return (C.project t)

  let fold s ~init ~f =
    let rec dig i path acc =
      if Compare.Int.(i <= 1) then
        C.fold s path ~init:acc ~f:(fun k acc ->
            match k with
            | `Dir _ ->
                Lwt.return acc
            | `Key file -> (
              match I.of_path file with
              | None ->
                  assert false
              | Some p ->
                  f p acc ))
      else
        C.fold s path ~init:acc ~f:(fun k acc ->
            match k with
            | `Dir k ->
                dig (i - 1) k acc
            | `Key _ ->
                Lwt.return acc)
    in
    dig I.path_length [] init

  let elements s = fold s ~init:[] ~f:(fun p acc -> Lwt.return (p :: acc))

  let () =
    let open Storage_description in
    let unpack = unpack I.args in
    register_value (* TODO fixme 'elements...' *)
      ~get:(fun c ->
        let (c, k) = unpack c in
        mem c k >>= function true -> return_some true | false -> return_none)
      (register_indexed_subcontext
         ~list:(fun c -> elements c >>= return)
         C.description
         I.args)
      Data_encoding.bool
end

module Make_indexed_data_storage (C : Raw_context.T) (I : INDEX) (V : VALUE) :
  Indexed_data_storage
    with type t = C.t
     and type key = I.t
     and type value = V.t = struct
  type t = C.t

  type context = t

  type key = I.t

  type value = V.t

  include Make_encoder (V)

  let mem s i = C.mem s (I.to_path i [])

  let get s i =
    C.get s (I.to_path i [])
    >>=? fun b ->
    let key = C.absolute_key s (I.to_path i []) in
    Lwt.return (of_bytes ~key b)

  let get_option s i =
    C.get_option s (I.to_path i [])
    >>= function
    | None ->
        return_none
    | Some b -> (
        let key = C.absolute_key s (I.to_path i []) in
        match of_bytes ~key b with
        | Ok v ->
            return_some v
        | Error _ as err ->
            Lwt.return err )

  let set s i v =
    C.set s (I.to_path i []) (to_bytes v) >>=? fun t -> return (C.project t)

  let init s i v =
    C.init s (I.to_path i []) (to_bytes v) >>=? fun t -> return (C.project t)

  let init_set s i v =
    C.init_set s (I.to_path i []) (to_bytes v)
    >>= fun t -> Lwt.return (C.project t)

  let set_option s i v =
    C.set_option s (I.to_path i []) (Option.map ~f:to_bytes v)
    >>= fun t -> Lwt.return (C.project t)

  let remove s i =
    C.remove s (I.to_path i []) >>= fun t -> Lwt.return (C.project t)

  let delete s i =
    C.delete s (I.to_path i []) >>=? fun t -> return (C.project t)

  let clear s = C.remove_rec s [] >>= fun t -> Lwt.return (C.project t)

  let fold_keys s ~init ~f =
    let rec dig i path acc =
      if Compare.Int.(i <= 1) then
        C.fold s path ~init:acc ~f:(fun k acc ->
            match k with
            | `Dir _ ->
                Lwt.return acc
            | `Key file -> (
              match I.of_path file with
              | None ->
                  assert false
              | Some path ->
                  f path acc ))
      else
        C.fold s path ~init:acc ~f:(fun k acc ->
            match k with
            | `Dir k ->
                dig (i - 1) k acc
            | `Key _ ->
                Lwt.return acc)
    in
    dig I.path_length [] init

  let fold s ~init ~f =
    let f path acc =
      get s path
      >>= function
      | Error _ ->
          (* FIXME: silently ignore unparsable data *)
          Lwt.return acc
      | Ok v ->
          f path v acc
    in
    fold_keys s ~init ~f

  let bindings s =
    fold s ~init:[] ~f:(fun p v acc -> Lwt.return ((p, v) :: acc))

  let keys s = fold_keys s ~init:[] ~f:(fun p acc -> Lwt.return (p :: acc))

  let () =
    let open Storage_description in
    let unpack = unpack I.args in
    register_value
      ~get:(fun c ->
        let (c, k) = unpack c in
        get_option c k)
      (register_indexed_subcontext
         ~list:(fun c -> keys c >>= return)
         C.description
         I.args)
      V.encoding
end

module Make_indexed_carbonated_data_storage
    (C : Raw_context.T)
    (I : INDEX)
    (V : VALUE) :
  Non_iterable_indexed_carbonated_data_storage
    with type t = C.t
     and type key = I.t
     and type value = V.t = struct
  type t = C.t

  type context = t

  type key = I.t

  type value = V.t

  include Make_encoder (V)

  let data_key i = I.to_path i [data_name]

  let len_key i = I.to_path i [len_name]

  let consume_mem_gas c =
    Lwt.return (C.consume_gas c (Gas_limit_repr.read_bytes_cost Z.zero))

  let existing_size c i =
    C.get_option c (len_key i)
    >>= function
    | None ->
        return (0, false)
    | Some len ->
        decode_len_value (len_key i) len >>=? fun len -> return (len, true)

  let consume_read_gas get c i =
    get c (len_key i)
    >>=? fun len ->
    decode_len_value (len_key i) len
    >>=? fun len ->
    Lwt.return
      (C.consume_gas c (Gas_limit_repr.read_bytes_cost (Z.of_int len)))

  let consume_serialize_write_gas set c i v =
    let bytes = to_bytes v in
    let len = MBytes.length bytes in
    Lwt.return (C.consume_gas c (Gas_limit_repr.alloc_mbytes_cost len))
    >>=? fun c ->
    Lwt.return
      (C.consume_gas c (Gas_limit_repr.write_bytes_cost (Z.of_int len)))
    >>=? fun c ->
    set c (len_key i) (encode_len_value bytes) >>=? fun c -> return (c, bytes)

  let consume_remove_gas del c i =
    Lwt.return (C.consume_gas c (Gas_limit_repr.write_bytes_cost Z.zero))
    >>=? fun c -> del c (len_key i)

  let mem s i =
    consume_mem_gas s
    >>=? fun s ->
    C.mem s (data_key i) >>= fun exists -> return (C.project s, exists)

  let get s i =
    consume_read_gas C.get s i
    >>=? fun s ->
    C.get s (data_key i)
    >>=? fun b ->
    let key = C.absolute_key s (data_key i) in
    Lwt.return (of_bytes ~key b) >>=? fun v -> return (C.project s, v)

  let get_option s i =
    consume_mem_gas s
    >>=? fun s ->
    C.mem s (data_key i)
    >>= fun exists ->
    if exists then get s i >>=? fun (s, v) -> return (s, Some v)
    else return (C.project s, None)

  let set s i v =
    existing_size s i
    >>=? fun (prev_size, _) ->
    consume_serialize_write_gas C.set s i v
    >>=? fun (s, bytes) ->
    C.set s (data_key i) bytes
    >>=? fun t ->
    let size_diff = MBytes.length bytes - prev_size in
    return (C.project t, size_diff)

  let init s i v =
    consume_serialize_write_gas C.init s i v
    >>=? fun (s, bytes) ->
    C.init s (data_key i) bytes
    >>=? fun t ->
    let size = MBytes.length bytes in
    return (C.project t, size)

  let init_set s i v =
    let init_set s i v = C.init_set s i v >>= return in
    existing_size s i
    >>=? fun (prev_size, existed) ->
    consume_serialize_write_gas init_set s i v
    >>=? fun (s, bytes) ->
    init_set s (data_key i) bytes
    >>=? fun t ->
    let size_diff = MBytes.length bytes - prev_size in
    return (C.project t, size_diff, existed)

  let remove s i =
    let remove s i = C.remove s i >>= return in
    existing_size s i
    >>=? fun (prev_size, existed) ->
    consume_remove_gas remove s i
    >>=? fun s ->
    remove s (data_key i) >>=? fun t -> return (C.project t, prev_size, existed)

  let delete s i =
    existing_size s i
    >>=? fun (prev_size, _) ->
    consume_remove_gas C.delete s i
    >>=? fun s ->
    C.delete s (data_key i) >>=? fun t -> return (C.project t, prev_size)

  let set_option s i v =
    match v with None -> remove s i | Some v -> init_set s i v

  let fold_keys_unaccounted s ~init ~f =
    let rec dig i path acc =
      if Compare.Int.(i <= 0) then
        C.fold s path ~init:acc ~f:(fun k acc ->
            match k with
            | `Dir _ ->
                Lwt.return acc
            | `Key file -> (
              match List.rev file with
              | last :: _ when Compare.String.(last = len_name) ->
                  Lwt.return acc
              | last :: rest when Compare.String.(last = data_name) -> (
                  let file = List.rev rest in
                  match I.of_path file with
                  | None ->
                      assert false
                  | Some path ->
                      f path acc )
              | _ ->
                  assert false ))
      else
        C.fold s path ~init:acc ~f:(fun k acc ->
            match k with
            | `Dir k ->
                dig (i - 1) k acc
            | `Key _ ->
                Lwt.return acc)
    in
    dig I.path_length [] init

  let keys_unaccounted s =
    fold_keys_unaccounted s ~init:[] ~f:(fun p acc -> Lwt.return (p :: acc))

  let () =
    let open Storage_description in
    let unpack = unpack I.args in
    register_value (* TODO export consumed gas ?? *)
      ~get:(fun c ->
        let (c, k) = unpack c in
        get_option c k >>=? fun (_, v) -> return v)
      (register_indexed_subcontext
         ~list:(fun c -> keys_unaccounted c >>= return)
         C.description
         I.args)
      V.encoding
end

module Make_indexed_data_snapshotable_storage
    (C : Raw_context.T)
    (Snapshot_index : INDEX)
    (I : INDEX)
    (V : VALUE) :
  Indexed_data_snapshotable_storage
    with type t = C.t
     and type snapshot = Snapshot_index.t
     and type key = I.t
     and type value = V.t = struct
  type snapshot = Snapshot_index.t

  let data_name = ["current"]

  let snapshot_name = ["snapshot"]

  module C_data =
    Make_subcontext (Registered) (C)
      (struct
        let name = data_name
      end)

  module C_snapshot =
    Make_subcontext (Registered) (C)
      (struct
        let name = snapshot_name
      end)

  include Make_indexed_data_storage (C_data) (I) (V)
  module Snapshot =
    Make_indexed_data_storage (C_snapshot) (Pair (Snapshot_index) (I)) (V)

  let snapshot_path id = snapshot_name @ Snapshot_index.to_path id []

  let snapshot_exists s id = C.dir_mem s (snapshot_path id)

  let snapshot s id =
    C.copy s ~from:data_name ~to_:(snapshot_path id)
    >>=? fun t -> return (C.project t)

  let delete_snapshot s id =
    C.remove_rec s (snapshot_path id) >>= fun t -> Lwt.return (C.project t)
end

module Make_indexed_subcontext (C : Raw_context.T) (I : INDEX) :
  Indexed_raw_context
    with type t = C.t
     and type key = I.t
     and type 'a ipath = 'a I.ipath = struct
  type t = C.t

  type context = t

  type key = I.t

  type 'a ipath = 'a I.ipath

  let clear t = C.remove_rec t [] >>= fun t -> Lwt.return (C.project t)

  let fold_keys t ~init ~f =
    let rec dig i path acc =
      if Compare.Int.(i <= 0) then
        match I.of_path path with
        | None ->
            assert false
        | Some path ->
            f path acc
      else
        C.fold t path ~init:acc ~f:(fun k acc ->
            match k with
            | `Dir k ->
                dig (i - 1) k acc
            | `Key _ ->
                Lwt.return acc)
    in
    dig I.path_length [] init

  let keys t = fold_keys t ~init:[] ~f:(fun i acc -> Lwt.return (i :: acc))

  let list t k = C.fold t k ~init:[] ~f:(fun k acc -> Lwt.return (k :: acc))

  let remove_rec t k = C.remove_rec t (I.to_path k [])

  let copy t ~from ~to_ =
    C.copy t ~from:(I.to_path from []) ~to_:(I.to_path to_ [])

  let description =
    Storage_description.register_indexed_subcontext
      ~list:(fun c -> keys c >>= return)
      C.description
      I.args

  let unpack = Storage_description.unpack I.args

  let pack = Storage_description.pack I.args

  module Raw_context = struct
    type t = C.t I.ipath

    type context = t

    let to_key i k = I.to_path i k

    let of_key k = Misc.remove_elem_from_list I.path_length k

    let mem c k =
      let (t, i) = unpack c in
      C.mem t (to_key i k)

    let dir_mem c k =
      let (t, i) = unpack c in
      C.dir_mem t (to_key i k)

    let get c k =
      let (t, i) = unpack c in
      C.get t (to_key i k)

    let get_option c k =
      let (t, i) = unpack c in
      C.get_option t (to_key i k)

    let init c k v =
      let (t, i) = unpack c in
      C.init t (to_key i k) v >>=? fun t -> return (pack t i)

    let set c k v =
      let (t, i) = unpack c in
      C.set t (to_key i k) v >>=? fun t -> return (pack t i)

    let init_set c k v =
      let (t, i) = unpack c in
      C.init_set t (to_key i k) v >>= fun t -> Lwt.return (pack t i)

    let set_option c k v =
      let (t, i) = unpack c in
      C.set_option t (to_key i k) v >>= fun t -> Lwt.return (pack t i)

    let delete c k =
      let (t, i) = unpack c in
      C.delete t (to_key i k) >>=? fun t -> return (pack t i)

    let remove c k =
      let (t, i) = unpack c in
      C.remove t (to_key i k) >>= fun t -> Lwt.return (pack t i)

    let remove_rec c k =
      let (t, i) = unpack c in
      C.remove_rec t (to_key i k) >>= fun t -> Lwt.return (pack t i)

    let copy c ~from ~to_ =
      let (t, i) = unpack c in
      C.copy t ~from:(to_key i from) ~to_:(to_key i to_)
      >>=? fun t -> return (pack t i)

    let fold c k ~init ~f =
      let (t, i) = unpack c in
      C.fold t (to_key i k) ~init ~f:(fun k acc -> f (map_key of_key k) acc)

    let keys c k =
      let (t, i) = unpack c in
      C.keys t (to_key i k) >|= fun keys -> List.map of_key keys

    let fold_keys c k ~init ~f =
      let (t, i) = unpack c in
      C.fold_keys t (to_key i k) ~init ~f:(fun k acc -> f (of_key k) acc)

    let project c =
      let (t, _) = unpack c in
      C.project t

    let absolute_key c k =
      let (t, i) = unpack c in
      C.absolute_key t (to_key i k)

    let consume_gas c g =
      let (t, i) = unpack c in
      C.consume_gas t g >>? fun t -> ok (pack t i)

    let check_enough_gas c g =
      let (t, _i) = unpack c in
      C.check_enough_gas t g

    let description = description
  end

  let resolve t prefix =
    let rec loop i prefix = function
      | [] when Compare.Int.(i = I.path_length) -> (
        match I.of_path prefix with
        | None ->
            assert false
        | Some path ->
            Lwt.return [path] )
      | [] ->
          list t prefix
          >>= fun prefixes ->
          Lwt_list.map_s
            (function `Key prefix | `Dir prefix -> loop (i + 1) prefix [])
            prefixes
          >|= List.flatten
      | [d] when Compare.Int.(i = I.path_length - 1) ->
          if Compare.Int.(i >= I.path_length) then invalid_arg "IO.resolve" ;
          list t prefix
          >>= fun prefixes ->
          Lwt_list.map_s
            (function
              | `Key prefix | `Dir prefix -> (
                match
                  Misc.remove_prefix ~prefix:d (List.hd (List.rev prefix))
                with
                | None ->
                    Lwt.return_nil
                | Some _ ->
                    loop (i + 1) prefix [] ))
            prefixes
          >|= List.flatten
      | "" :: ds ->
          list t prefix
          >>= fun prefixes ->
          Lwt_list.map_s
            (function `Key prefix | `Dir prefix -> loop (i + 1) prefix ds)
            prefixes
          >|= List.flatten
      | d :: ds -> (
          if Compare.Int.(i >= I.path_length) then invalid_arg "IO.resolve" ;
          C.dir_mem t (prefix @ [d])
          >>= function
          | true -> loop (i + 1) (prefix @ [d]) ds | false -> Lwt.return_nil )
    in
    loop 0 [] prefix

  module Make_set (R : REGISTER) (N : NAME) = struct
    type t = C.t

    type context = t

    type elt = I.t

    let inited = MBytes.of_string "inited"

    let mem s i = Raw_context.mem (pack s i) N.name

    let add s i =
      Raw_context.init_set (pack s i) N.name inited
      >>= fun c ->
      let (s, _) = unpack c in
      Lwt.return (C.project s)

    let del s i =
      Raw_context.remove (pack s i) N.name
      >>= fun c ->
      let (s, _) = unpack c in
      Lwt.return (C.project s)

    let set s i = function true -> add s i | false -> del s i

    let clear s =
      fold_keys s ~init:s ~f:(fun i s ->
          Raw_context.remove (pack s i) N.name
          >>= fun c ->
          let (s, _) = unpack c in
          Lwt.return s)
      >>= fun t -> Lwt.return (C.project t)

    let fold s ~init ~f =
      fold_keys s ~init ~f:(fun i acc ->
          mem s i >>= function true -> f i acc | false -> Lwt.return acc)

    let elements s = fold s ~init:[] ~f:(fun p acc -> Lwt.return (p :: acc))

    let () =
      let open Storage_description in
      let unpack = unpack I.args in
      let description =
        if R.ghost then Storage_description.create ()
        else Raw_context.description
      in
      register_value
        ~get:(fun c ->
          let (c, k) = unpack c in
          mem c k
          >>= function true -> return_some true | false -> return_none)
        (register_named_subcontext description N.name)
        Data_encoding.bool
  end

  module Make_map (N : NAME) (V : VALUE) = struct
    type t = C.t

    type context = t

    type key = I.t

    type value = V.t

    include Make_encoder (V)

    let mem s i = Raw_context.mem (pack s i) N.name

    let get s i =
      Raw_context.get (pack s i) N.name
      >>=? fun b ->
      let key = Raw_context.absolute_key (pack s i) N.name in
      Lwt.return (of_bytes ~key b)

    let get_option s i =
      Raw_context.get_option (pack s i) N.name
      >>= function
      | None ->
          return_none
      | Some b -> (
          let key = Raw_context.absolute_key (pack s i) N.name in
          match of_bytes ~key b with
          | Ok v ->
              return_some v
          | Error _ as err ->
              Lwt.return err )

    let set s i v =
      Raw_context.set (pack s i) N.name (to_bytes v)
      >>=? fun c ->
      let (s, _) = unpack c in
      return (C.project s)

    let init s i v =
      Raw_context.init (pack s i) N.name (to_bytes v)
      >>=? fun c ->
      let (s, _) = unpack c in
      return (C.project s)

    let init_set s i v =
      Raw_context.init_set (pack s i) N.name (to_bytes v)
      >>= fun c ->
      let (s, _) = unpack c in
      Lwt.return (C.project s)

    let set_option s i v =
      Raw_context.set_option (pack s i) N.name (Option.map ~f:to_bytes v)
      >>= fun c ->
      let (s, _) = unpack c in
      Lwt.return (C.project s)

    let remove s i =
      Raw_context.remove (pack s i) N.name
      >>= fun c ->
      let (s, _) = unpack c in
      Lwt.return (C.project s)

    let delete s i =
      Raw_context.delete (pack s i) N.name
      >>=? fun c ->
      let (s, _) = unpack c in
      return (C.project s)

    let clear s =
      fold_keys s ~init:s ~f:(fun i s ->
          Raw_context.remove (pack s i) N.name
          >>= fun c ->
          let (s, _) = unpack c in
          Lwt.return s)
      >>= fun t -> Lwt.return (C.project t)

    let fold s ~init ~f =
      fold_keys s ~init ~f:(fun i acc ->
          get s i >>= function Error _ -> Lwt.return acc | Ok v -> f i v acc)

    let bindings s =
      fold s ~init:[] ~f:(fun p v acc -> Lwt.return ((p, v) :: acc))

    let fold_keys s ~init ~f =
      fold_keys s ~init ~f:(fun i acc ->
          mem s i >>= function false -> Lwt.return acc | true -> f i acc)

    let keys s = fold_keys s ~init:[] ~f:(fun p acc -> Lwt.return (p :: acc))

    let () =
      let open Storage_description in
      let unpack = unpack I.args in
      register_value
        ~get:(fun c ->
          let (c, k) = unpack c in
          get_option c k)
        (register_named_subcontext Raw_context.description N.name)
        V.encoding
  end

  module Make_carbonated_map (N : NAME) (V : VALUE) = struct
    type t = C.t

    type context = t

    type key = I.t

    type value = V.t

    include Make_encoder (V)

    let len_name = len_name :: N.name

    let data_name = data_name :: N.name

    let consume_mem_gas c =
      Lwt.return
        (Raw_context.consume_gas c (Gas_limit_repr.read_bytes_cost Z.zero))

    let existing_size c =
      Raw_context.get_option c len_name
      >>= function
      | None ->
          return (0, false)
      | Some len ->
          decode_len_value len_name len >>=? fun len -> return (len, true)

    let consume_read_gas get c =
      get c len_name
      >>=? fun len ->
      decode_len_value len_name len
      >>=? fun len ->
      Lwt.return
        (Raw_context.consume_gas
           c
           (Gas_limit_repr.read_bytes_cost (Z.of_int len)))

    let consume_write_gas set c v =
      let bytes = to_bytes v in
      let len = MBytes.length bytes in
      Lwt.return
        (Raw_context.consume_gas
           c
           (Gas_limit_repr.write_bytes_cost (Z.of_int len)))
      >>=? fun c ->
      set c len_name (encode_len_value bytes) >>=? fun c -> return (c, bytes)

    let consume_remove_gas del c =
      Lwt.return
        (Raw_context.consume_gas c (Gas_limit_repr.write_bytes_cost Z.zero))
      >>=? fun c -> del c len_name

    let mem s i =
      consume_mem_gas (pack s i)
      >>=? fun c ->
      Raw_context.mem c data_name
      >>= fun res -> return (Raw_context.project c, res)

    let get s i =
      consume_read_gas Raw_context.get (pack s i)
      >>=? fun c ->
      Raw_context.get c data_name
      >>=? fun b ->
      let key = Raw_context.absolute_key c data_name in
      Lwt.return (of_bytes ~key b)
      >>=? fun v -> return (Raw_context.project c, v)

    let get_option s i =
      consume_mem_gas (pack s i)
      >>=? fun c ->
      let (s, _) = unpack c in
      Raw_context.mem (pack s i) data_name
      >>= fun exists ->
      if exists then get s i >>=? fun (s, v) -> return (s, Some v)
      else return (C.project s, None)

    let set s i v =
      existing_size (pack s i)
      >>=? fun (prev_size, _) ->
      consume_write_gas Raw_context.set (pack s i) v
      >>=? fun (c, bytes) ->
      Raw_context.set c data_name bytes
      >>=? fun c ->
      let size_diff = MBytes.length bytes - prev_size in
      return (Raw_context.project c, size_diff)

    let init s i v =
      consume_write_gas Raw_context.init (pack s i) v
      >>=? fun (c, bytes) ->
      Raw_context.init c data_name bytes
      >>=? fun c ->
      let size = MBytes.length bytes in
      return (Raw_context.project c, size)

    let init_set s i v =
      let init_set c k v = Raw_context.init_set c k v >>= return in
      existing_size (pack s i)
      >>=? fun (prev_size, existed) ->
      consume_write_gas init_set (pack s i) v
      >>=? fun (c, bytes) ->
      init_set c data_name bytes
      >>=? fun c ->
      let size_diff = MBytes.length bytes - prev_size in
      return (Raw_context.project c, size_diff, existed)

    let remove s i =
      let remove c k = Raw_context.remove c k >>= return in
      existing_size (pack s i)
      >>=? fun (prev_size, existed) ->
      consume_remove_gas remove (pack s i)
      >>=? fun c ->
      remove c data_name
      >>=? fun c -> return (Raw_context.project c, prev_size, existed)

    let delete s i =
      existing_size (pack s i)
      >>=? fun (prev_size, _) ->
      consume_remove_gas Raw_context.delete (pack s i)
      >>=? fun c ->
      Raw_context.delete c data_name
      >>=? fun c -> return (Raw_context.project c, prev_size)

    let set_option s i v =
      match v with None -> remove s i | Some v -> init_set s i v

    let () =
      let open Storage_description in
      let unpack = unpack I.args in
      register_value
        ~get:(fun c ->
          let (c, k) = unpack c in
          get_option c k >>=? fun (_, v) -> return v)
        (register_named_subcontext Raw_context.description N.name)
        V.encoding
  end
end

module Wrap_indexed_data_storage
    (C : Indexed_data_storage) (K : sig
      type t

      val wrap : t -> C.key

      val unwrap : C.key -> t option
    end) =
struct
  type t = C.t

  type context = C.t

  type key = K.t

  type value = C.value

  let mem ctxt k = C.mem ctxt (K.wrap k)

  let get ctxt k = C.get ctxt (K.wrap k)

  let get_option ctxt k = C.get_option ctxt (K.wrap k)

  let set ctxt k v = C.set ctxt (K.wrap k) v

  let init ctxt k v = C.init ctxt (K.wrap k) v

  let init_set ctxt k v = C.init_set ctxt (K.wrap k) v

  let set_option ctxt k v = C.set_option ctxt (K.wrap k) v

  let delete ctxt k = C.delete ctxt (K.wrap k)

  let remove ctxt k = C.remove ctxt (K.wrap k)

  let clear ctxt = C.clear ctxt

  let fold ctxt ~init ~f =
    C.fold ctxt ~init ~f:(fun k v acc ->
        match K.unwrap k with None -> Lwt.return acc | Some k -> f k v acc)

  let bindings s =
    fold s ~init:[] ~f:(fun p v acc -> Lwt.return ((p, v) :: acc))

  let fold_keys s ~init ~f =
    C.fold_keys s ~init ~f:(fun k acc ->
        match K.unwrap k with None -> Lwt.return acc | Some k -> f k acc)

  let keys s = fold_keys s ~init:[] ~f:(fun p acc -> Lwt.return (p :: acc))
end

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Import Storage_sigs.

Module Registered.
  Definition ghost : bool := false.
End Registered.

Module Ghost.
  Definition ghost : bool := true.
End Ghost.

(* ❌ Functors are not handled. *)
functor

Definition len_name : string := "len" % string.

Definition data_name : string := "data" % string.

Definition encode_len_value
  (__bytes_value : Tezos_protocol_environment_alpha__Environment.MBytes.t)
  : Tezos_protocol_environment_alpha__Environment.MBytes.t :=
  let length := MBytes.length __bytes_value in
  (Binary.to_bytes_exn int31) length.

Definition decode_len_value
  (key : list string)
  (len : Tezos_protocol_environment_alpha__Environment.MBytes.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult Z) :=
  match (Binary.of_bytes int31) len with
  | None =>
    fail
      (Tezos_protocol_environment_alpha__Environment.Error_monad.Storage_error
        (Tezos_raw_protocol_alpha.Raw_context.Corrupted_data key))
  | Some len => __return len
  end.

Definition map_key {A B : Set} (f : A -> B) (function_parameter : (* `Key *) A)
  : (* `Key *) B :=
  match function_parameter with
  | Key k =>
    (* ❌ Variants not supported *)
    variant
  | Dir k =>
    (* ❌ Variants not supported *)
    variant
  end.

(* ❌ Functors are not handled. *)
functor

(* ❌ Functors are not handled. *)
functor

Module INDEX.
  Record signature {t : Set} {ipath : Set -> Set} := {
    t := t;
    path_length : Z;
    to_path : t -> list string -> list string;
    of_path : list string -> option t;
    ipath := ipath;
    args : forall {a : Set},
      Tezos_raw_protocol_alpha.Storage_description.args a t (ipath a);
  }.
  Arguments signature : clear implicits.
End INDEX.

(* ❌ Functors are not handled. *)
functor

(* ❌ Functors are not handled. *)
functor

(* ❌ Functors are not handled. *)
functor

(* ❌ Functors are not handled. *)
functor

(* ❌ Functors are not handled. *)
functor

(* ❌ Functors are not handled. *)
functor

(* ❌ Functors are not handled. *)
functor

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

(** Tezos Protocol Implementation - Typed storage builders. *)

open Storage_sigs

module Registered : REGISTER

module Ghost : REGISTER

module Make_subcontext (R : REGISTER) (C : Raw_context.T) (N : NAME) :
  Raw_context.T with type t = C.t

module Make_single_data_storage
    (R : REGISTER)
    (C : Raw_context.T)
    (N : NAME)
    (V : VALUE) : Single_data_storage with type t = C.t and type value = V.t

module type INDEX = sig
  type t

  val path_length : int

  val to_path : t -> string list -> string list

  val of_path : string list -> t option

  type 'a ipath

  val args : ('a, t, 'a ipath) Storage_description.args
end

module Pair (I1 : INDEX) (I2 : INDEX) : INDEX with type t = I1.t * I2.t

module Make_data_set_storage (C : Raw_context.T) (I : INDEX) :
  Data_set_storage with type t = C.t and type elt = I.t

module Make_indexed_data_storage (C : Raw_context.T) (I : INDEX) (V : VALUE) :
  Indexed_data_storage
    with type t = C.t
     and type key = I.t
     and type value = V.t

module Make_indexed_carbonated_data_storage
    (C : Raw_context.T)
    (I : INDEX)
    (V : VALUE) :
  Non_iterable_indexed_carbonated_data_storage
    with type t = C.t
     and type key = I.t
     and type value = V.t

module Make_indexed_data_snapshotable_storage
    (C : Raw_context.T)
    (Snapshot : INDEX)
    (I : INDEX)
    (V : VALUE) :
  Indexed_data_snapshotable_storage
    with type t = C.t
     and type snapshot = Snapshot.t
     and type key = I.t
     and type value = V.t

module Make_indexed_subcontext (C : Raw_context.T) (I : INDEX) :
  Indexed_raw_context
    with type t = C.t
     and type key = I.t
     and type 'a ipath = 'a I.ipath

module Wrap_indexed_data_storage
    (C : Indexed_data_storage) (K : sig
      type t

      val wrap : t -> C.key

      val unwrap : C.key -> t option
    end) :
  Indexed_data_storage
    with type t = C.t
     and type key = K.t
     and type value = C.value

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Module Registered.
  Parameter ghost : bool.
End Registered.

Module Ghost.
  Parameter ghost : bool.
End Ghost.

Module Make_subcontext.
  (* Unhandled functor *)
End Make_subcontext.

Module Make_single_data_storage.
  (* Unhandled functor *)
End Make_single_data_storage.

Module INDEX.
  Record signature {t : Set} {ipath : Set -> Set} := {
    t := t;
    path_length : Z;
    to_path : t -> list string -> list string;
    of_path : list string -> option t;
    ipath := ipath;
    args : forall {a : Set},
      Tezos_raw_protocol_alpha.Storage_description.args a t (ipath a);
  }.
  Arguments signature : clear implicits.
End INDEX.

Module Pair.
  (* Unhandled functor *)
End Pair.

Module Make_data_set_storage.
  (* Unhandled functor *)
End Make_data_set_storage.

Module Make_indexed_data_storage.
  (* Unhandled functor *)
End Make_indexed_data_storage.

Module Make_indexed_carbonated_data_storage.
  (* Unhandled functor *)
End Make_indexed_carbonated_data_storage.

Module Make_indexed_data_snapshotable_storage.
  (* Unhandled functor *)
End Make_indexed_data_snapshotable_storage.

Module Make_indexed_subcontext.
  (* Unhandled functor *)
End Make_indexed_subcontext.

Module Wrap_indexed_data_storage.
  (* Unhandled functor *)
End Wrap_indexed_data_storage.

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

(** {1 Entity Accessor Signatures} *)

(** The generic signature of a single data accessor (a single value
    bound to a specific key in the hierarchical (key x value)
    database). *)
module type Single_data_storage = sig
  type t

  type context = t

  (** The type of the value *)
  type value

  (** Tells if the data is already defined *)
  val mem : context -> bool Lwt.t

  (** Retrieve the value from the storage bucket ; returns a
      {!Storage_error} if the key is not set or if the deserialisation
      fails *)
  val get : context -> value tzresult Lwt.t

  (** Retrieves the value from the storage bucket ; returns [None] if
      the data is not initialized, or {!Storage_helpers.Storage_error}
      if the deserialisation fails *)
  val get_option : context -> value option tzresult Lwt.t

  (** Allocates the storage bucket and initializes it ; returns a
      {!Storage_error Existing_key} if the bucket exists *)
  val init : context -> value -> Raw_context.t tzresult Lwt.t

  (** Updates the content of the bucket ; returns a {!Storage_Error
      Missing_key} if the value does not exists *)
  val set : context -> value -> Raw_context.t tzresult Lwt.t

  (** Allocates the data and initializes it with a value ; just
      updates it if the bucket exists *)
  val init_set : context -> value -> Raw_context.t Lwt.t

  (** When the value is [Some v], allocates the data and initializes
      it with [v] ; just updates it if the bucket exists. When the
      valus is [None], delete the storage bucket when the value ; does
      nothing if the bucket does not exists. *)
  val set_option : context -> value option -> Raw_context.t Lwt.t

  (** Delete the storage bucket ; returns a {!Storage_error
      Missing_key} if the bucket does not exists *)
  val delete : context -> Raw_context.t tzresult Lwt.t

  (** Removes the storage bucket and its contents ; does nothing if
      the bucket does not exists *)
  val remove : context -> Raw_context.t Lwt.t
end

(** Variant of {!Single_data_storage} with gas accounting. *)
module type Single_carbonated_data_storage = sig
  type t

  type context = t

  (** The type of the value *)
  type value

  (** Tells if the data is already defined.
      Consumes [Gas_repr.read_bytes_cost Z.zero]. *)
  val mem : context -> (Raw_context.t * bool) tzresult Lwt.t

  (** Retrieve the value from the storage bucket ; returns a
      {!Storage_error} if the key is not set or if the deserialisation
      fails.
      Consumes [Gas_repr.read_bytes_cost <size of the value>]. *)
  val get : context -> (Raw_context.t * value) tzresult Lwt.t

  (** Retrieves the value from the storage bucket ; returns [None] if
      the data is not initialized, or {!Storage_helpers.Storage_error}
      if the deserialisation fails.
      Consumes [Gas_repr.read_bytes_cost <size of the value>] if present
      or [Gas_repr.read_bytes_cost Z.zero]. *)
  val get_option : context -> (Raw_context.t * value option) tzresult Lwt.t

  (** Allocates the storage bucket and initializes it ; returns a
      {!Storage_error Missing_key} if the bucket exists.
      Consumes [Gas_repr.write_bytes_cost <size of the value>].
      Returns the size. *)
  val init : context -> value -> (Raw_context.t * int) tzresult Lwt.t

  (** Updates the content of the bucket ; returns a {!Storage_Error
      Existing_key} if the value does not exists.
      Consumes [Gas_repr.write_bytes_cost <size of the new value>].
      Returns the difference from the old to the new size. *)
  val set : context -> value -> (Raw_context.t * int) tzresult Lwt.t

  (** Allocates the data and initializes it with a value ; just
      updates it if the bucket exists.
      Consumes [Gas_repr.write_bytes_cost <size of the new value>].
      Returns the difference from the old (maybe 0) to the new size, and a boolean
      indicating if a value was already associated to this key. *)
  val init_set :
    context -> value -> (Raw_context.t * int * bool) tzresult Lwt.t

  (** When the value is [Some v], allocates the data and initializes
      it with [v] ; just updates it if the bucket exists. When the
      valus is [None], delete the storage bucket when the value ; does
      nothing if the bucket does not exists.
      Consumes the same gas cost as either {!remove} or {!init_set}.
      Returns the difference from the old (maybe 0) to the new size, and a boolean
      indicating if a value was already associated to this key. *)
  val set_option :
    context -> value option -> (Raw_context.t * int * bool) tzresult Lwt.t

  (** Delete the storage bucket ; returns a {!Storage_error
      Missing_key} if the bucket does not exists.
      Consumes [Gas_repr.write_bytes_cost Z.zero].
      Returns the freed size. *)
  val delete : context -> (Raw_context.t * int) tzresult Lwt.t

  (** Removes the storage bucket and its contents ; does nothing if
      the bucket does not exists.
      Consumes [Gas_repr.write_bytes_cost Z.zero].
      Returns the freed size, and a boolean
      indicating if a value was already associated to this key. *)
  val remove : context -> (Raw_context.t * int * bool) tzresult Lwt.t
end

(** Restricted version of {!Indexed_data_storage} w/o iterators. *)
module type Non_iterable_indexed_data_storage = sig
  type t

  type context = t

  (** An abstract type for keys *)
  type key

  (** The type of values *)
  type value

  (** Tells if a given key is already bound to a storage bucket *)
  val mem : context -> key -> bool Lwt.t

  (** Retrieve a value from the storage bucket at a given key ;
      returns {!Storage_error Missing_key} if the key is not set ;
      returns {!Storage_error Corrupted_data} if the deserialisation
      fails. *)
  val get : context -> key -> value tzresult Lwt.t

  (** Retrieve a value from the storage bucket at a given key ;
      returns [None] if the value is not set ; returns {!Storage_error
      Corrupted_data} if the deserialisation fails. *)
  val get_option : context -> key -> value option tzresult Lwt.t

  (** Updates the content of a bucket ; returns A {!Storage_Error
      Missing_key} if the value does not exists. *)
  val set : context -> key -> value -> Raw_context.t tzresult Lwt.t

  (** Allocates a storage bucket at the given key and initializes it ;
      returns a {!Storage_error Existing_key} if the bucket exists. *)
  val init : context -> key -> value -> Raw_context.t tzresult Lwt.t

  (** Allocates a storage bucket at the given key and initializes it
      with a value ; just updates it if the bucket exists. *)
  val init_set : context -> key -> value -> Raw_context.t Lwt.t

  (** When the value is [Some v], allocates the data and initializes
      it with [v] ; just updates it if the bucket exists. When the
      valus is [None], delete the storage bucket when the value ; does
      nothing if the bucket does not exists. *)
  val set_option : context -> key -> value option -> Raw_context.t Lwt.t

  (** Delete a storage bucket and its contents ; returns a
      {!Storage_error Missing_key} if the bucket does not exists. *)
  val delete : context -> key -> Raw_context.t tzresult Lwt.t

  (** Removes a storage bucket and its contents ; does nothing if the
      bucket does not exists. *)
  val remove : context -> key -> Raw_context.t Lwt.t
end

(** Variant of {!Non_iterable_indexed_data_storage} with gas accounting. *)
module type Non_iterable_indexed_carbonated_data_storage = sig
  type t

  type context = t

  (** An abstract type for keys *)
  type key

  (** The type of values *)
  type value

  (** Tells if a given key is already bound to a storage bucket.
      Consumes [Gas_repr.read_bytes_cost Z.zero]. *)
  val mem : context -> key -> (Raw_context.t * bool) tzresult Lwt.t

  (** Retrieve a value from the storage bucket at a given key ;
      returns {!Storage_error Missing_key} if the key is not set ;
      returns {!Storage_error Corrupted_data} if the deserialisation
      fails.
      Consumes [Gas_repr.read_bytes_cost <size of the value>]. *)
  val get : context -> key -> (Raw_context.t * value) tzresult Lwt.t

  (** Retrieve a value from the storage bucket at a given key ;
      returns [None] if the value is not set ; returns {!Storage_error
      Corrupted_data} if the deserialisation fails.
      Consumes [Gas_repr.read_bytes_cost <size of the value>] if present
      or [Gas_repr.read_bytes_cost Z.zero]. *)
  val get_option :
    context -> key -> (Raw_context.t * value option) tzresult Lwt.t

  (** Updates the content of a bucket ; returns A {!Storage_Error
      Missing_key} if the value does not exists.
      Consumes serialization cost.
      Consumes [Gas_repr.write_bytes_cost <size of the new value>].
      Returns the difference from the old to the new size. *)
  val set : context -> key -> value -> (Raw_context.t * int) tzresult Lwt.t

  (** Allocates a storage bucket at the given key and initializes it ;
      returns a {!Storage_error Existing_key} if the bucket exists.
      Consumes serialization cost.
      Consumes [Gas_repr.write_bytes_cost <size of the value>].
      Returns the size. *)
  val init : context -> key -> value -> (Raw_context.t * int) tzresult Lwt.t

  (** Allocates a storage bucket at the given key and initializes it
      with a value ; just updates it if the bucket exists.
      Consumes serialization cost.
      Consumes [Gas_repr.write_bytes_cost <size of the new value>].
      Returns the difference from the old (maybe 0) to the new size, and a boolean
      indicating if a value was already associated to this key. *)
  val init_set :
    context -> key -> value -> (Raw_context.t * int * bool) tzresult Lwt.t

  (** When the value is [Some v], allocates the data and initializes
      it with [v] ; just updates it if the bucket exists. When the
      valus is [None], delete the storage bucket when the value ; does
      nothing if the bucket does not exists.
      Consumes serialization cost.
      Consumes the same gas cost as either {!remove} or {!init_set}.
      Returns the difference from the old (maybe 0) to the new size, and a boolean
      indicating if a value was already associated to this key. *)
  val set_option :
    context ->
    key ->
    value option ->
    (Raw_context.t * int * bool) tzresult Lwt.t

  (** Delete a storage bucket and its contents ; returns a
      {!Storage_error Missing_key} if the bucket does not exists.
      Consumes [Gas_repr.write_bytes_cost Z.zero].
      Returns the freed size. *)
  val delete : context -> key -> (Raw_context.t * int) tzresult Lwt.t

  (** Removes a storage bucket and its contents ; does nothing if the
      bucket does not exists.
      Consumes [Gas_repr.write_bytes_cost Z.zero].
      Returns the freed size, and a boolean
      indicating if a value was already associated to this key. *)
  val remove : context -> key -> (Raw_context.t * int * bool) tzresult Lwt.t
end

(** The generic signature of indexed data accessors (a set of values
    of the same type indexed by keys of the same form in the
    hierarchical (key x value) database). *)
module type Indexed_data_storage = sig
  include Non_iterable_indexed_data_storage

  (** Empties all the keys and associated data. *)
  val clear : context -> Raw_context.t Lwt.t

  (** Lists all the keys. *)
  val keys : context -> key list Lwt.t

  (** Lists all the keys and associated data. *)
  val bindings : context -> (key * value) list Lwt.t

  (** Iterates over all the keys and associated data. *)
  val fold :
    context -> init:'a -> f:(key -> value -> 'a -> 'a Lwt.t) -> 'a Lwt.t

  (** Iterate over all the keys. *)
  val fold_keys : context -> init:'a -> f:(key -> 'a -> 'a Lwt.t) -> 'a Lwt.t
end

module type Indexed_data_snapshotable_storage = sig
  type snapshot

  type key

  include Indexed_data_storage with type key := key

  module Snapshot :
    Indexed_data_storage
      with type key = snapshot * key
       and type value = value
       and type t = t

  val snapshot_exists : context -> snapshot -> bool Lwt.t

  val snapshot : context -> snapshot -> Raw_context.t tzresult Lwt.t

  val delete_snapshot : context -> snapshot -> Raw_context.t Lwt.t
end

(** The generic signature of a data set accessor (a set of values
    bound to a specific key prefix in the hierarchical (key x value)
    database). *)
module type Data_set_storage = sig
  type t

  type context = t

  (** The type of elements. *)
  type elt

  (** Tells if a elt is a member of the set *)
  val mem : context -> elt -> bool Lwt.t

  (** Adds a elt is a member of the set *)
  val add : context -> elt -> Raw_context.t Lwt.t

  (** Removes a elt of the set ; does nothing if not a member *)
  val del : context -> elt -> Raw_context.t Lwt.t

  (** Adds/Removes a elt of the set *)
  val set : context -> elt -> bool -> Raw_context.t Lwt.t

  (** Returns the elements of the set, deserialized in a list in no
      particular order. *)
  val elements : context -> elt list Lwt.t

  (** Iterates over the elements of the set. *)
  val fold : context -> init:'a -> f:(elt -> 'a -> 'a Lwt.t) -> 'a Lwt.t

  (** Removes all elements in the set *)
  val clear : context -> Raw_context.t Lwt.t
end

module type NAME = sig
  val name : Raw_context.key
end

module type VALUE = sig
  type t

  val encoding : t Data_encoding.t
end

module type REGISTER = sig
  val ghost : bool
end

module type Indexed_raw_context = sig
  type t

  type context = t

  type key

  type 'a ipath

  val clear : context -> Raw_context.t Lwt.t

  val fold_keys : context -> init:'a -> f:(key -> 'a -> 'a Lwt.t) -> 'a Lwt.t

  val keys : context -> key list Lwt.t

  val resolve : context -> string list -> key list Lwt.t

  val remove_rec : context -> key -> context Lwt.t

  val copy : context -> from:key -> to_:key -> context tzresult Lwt.t

  module Make_set (R : REGISTER) (N : NAME) :
    Data_set_storage with type t = t and type elt = key

  module Make_map (N : NAME) (V : VALUE) :
    Indexed_data_storage
      with type t = t
       and type key = key
       and type value = V.t

  module Make_carbonated_map (N : NAME) (V : VALUE) :
    Non_iterable_indexed_carbonated_data_storage
      with type t = t
       and type key = key
       and type value = V.t

  module Raw_context : Raw_context.T with type t = t ipath
end

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Module Single_data_storage.
  Record signature {t value : Set} := {
    t := t;
    context := t;
    value := value;
    mem : context -> Tezos_protocol_environment_alpha__Environment.Lwt.t bool;
    get :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          value);
    get_option :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (option value));
    init :
      context -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t);
    set :
      context -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t);
    init_set :
      context -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t;
    set_option :
      context -> option value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t;
    delete :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t);
    remove :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t;
  }.
  Arguments signature : clear implicits.
End Single_data_storage.

Module Single_carbonated_data_storage.
  Record signature {t value : Set} := {
    t := t;
    context := t;
    value := value;
    mem :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_raw_protocol_alpha.Raw_context.t * bool));
    get :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_raw_protocol_alpha.Raw_context.t * value));
    get_option :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_raw_protocol_alpha.Raw_context.t * option value));
    init :
      context -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_raw_protocol_alpha.Raw_context.t * Z));
    set :
      context -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_raw_protocol_alpha.Raw_context.t * Z));
    init_set :
      context -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_raw_protocol_alpha.Raw_context.t * Z * bool));
    set_option :
      context -> option value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_raw_protocol_alpha.Raw_context.t * Z * bool));
    delete :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_raw_protocol_alpha.Raw_context.t * Z));
    remove :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_raw_protocol_alpha.Raw_context.t * Z * bool));
  }.
  Arguments signature : clear implicits.
End Single_carbonated_data_storage.

Module Non_iterable_indexed_data_storage.
  Record signature {t key value : Set} := {
    t := t;
    context := t;
    key := key;
    value := value;
    mem :
      context -> key -> Tezos_protocol_environment_alpha__Environment.Lwt.t bool;
    get :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          value);
    get_option :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (option value));
    set :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t);
    init :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t);
    init_set :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t;
    set_option :
      context -> key -> option value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t;
    delete :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t);
    remove :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t;
  }.
  Arguments signature : clear implicits.
End Non_iterable_indexed_data_storage.

Module Non_iterable_indexed_carbonated_data_storage.
  Record signature {t key value : Set} := {
    t := t;
    context := t;
    key := key;
    value := value;
    mem :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_raw_protocol_alpha.Raw_context.t * bool));
    get :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_raw_protocol_alpha.Raw_context.t * value));
    get_option :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_raw_protocol_alpha.Raw_context.t * option value));
    set :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_raw_protocol_alpha.Raw_context.t * Z));
    init :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_raw_protocol_alpha.Raw_context.t * Z));
    init_set :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_raw_protocol_alpha.Raw_context.t * Z * bool));
    set_option :
      context -> key -> option value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_raw_protocol_alpha.Raw_context.t * Z * bool));
    delete :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_raw_protocol_alpha.Raw_context.t * Z));
    remove :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_raw_protocol_alpha.Raw_context.t * Z * bool));
  }.
  Arguments signature : clear implicits.
End Non_iterable_indexed_carbonated_data_storage.

Module Indexed_data_storage.
  Record signature {t key value : Set} := {
    t := t;
    context := t;
    key := key;
    value := value;
    mem :
      context -> key -> Tezos_protocol_environment_alpha__Environment.Lwt.t bool;
    get :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          value);
    get_option :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (option value));
    set :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t);
    init :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t);
    init_set :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t;
    set_option :
      context -> key -> option value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t;
    delete :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t);
    remove :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t;
    clear :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t;
    keys :
      context -> Tezos_protocol_environment_alpha__Environment.Lwt.t (list key);
    bindings :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t (list (key * value));
    fold : forall {a : Set},
      context -> a ->
      (key -> value -> a ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a;
    fold_keys : forall {a : Set},
      context -> a ->
      (key -> a -> Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a;
  }.
  Arguments signature : clear implicits.
End Indexed_data_storage.

Module Indexed_data_snapshotable_storage.
  Record signature {snapshot key t value : Set} := {
    snapshot := snapshot;
    key := key;
    t := t;
    context := t;
    value := value;
    mem :
      context -> key -> Tezos_protocol_environment_alpha__Environment.Lwt.t bool;
    get :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          value);
    get_option :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (option value));
    set :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t);
    init :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t);
    init_set :
      context -> key -> value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t;
    set_option :
      context -> key -> option value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t;
    delete :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t);
    remove :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t;
    clear :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t;
    keys :
      context -> Tezos_protocol_environment_alpha__Environment.Lwt.t (list key);
    bindings :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t (list (key * value));
    fold : forall {a : Set},
      context -> a ->
      (key -> value -> a ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a;
    fold_keys : forall {a : Set},
      context -> a ->
      (key -> a -> Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a;
    Snapshot : Indexed_data_storage.signature t (snapshot * key) value;
    snapshot_exists :
      context -> snapshot ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t bool;
    snapshot :
      context -> snapshot ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t);
    delete_snapshot :
      context -> snapshot ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t;
  }.
  Arguments signature : clear implicits.
End Indexed_data_snapshotable_storage.

Module Data_set_storage.
  Record signature {t elt : Set} := {
    t := t;
    context := t;
    elt := elt;
    mem :
      context -> elt -> Tezos_protocol_environment_alpha__Environment.Lwt.t bool;
    add :
      context -> elt ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t;
    del :
      context -> elt ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t;
    set :
      context -> elt -> bool ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t;
    elements :
      context -> Tezos_protocol_environment_alpha__Environment.Lwt.t (list elt);
    fold : forall {a : Set},
      context -> a ->
      (elt -> a -> Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a;
    clear :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t;
  }.
  Arguments signature : clear implicits.
End Data_set_storage.

Module NAME.
  Record signature := {
    name : Tezos_raw_protocol_alpha.Raw_context.key;
  }.
End NAME.

Module VALUE.
  Record signature {t : Set} := {
    t := t;
    encoding : Tezos_protocol_environment_alpha__Environment.Data_encoding.t t;
  }.
  Arguments signature : clear implicits.
End VALUE.

Module REGISTER.
  Record signature := {
    ghost : bool;
  }.
End REGISTER.

Module Indexed_raw_context.
  Record signature {t key : Set} {ipath : Set -> Set} := {
    t := t;
    context := t;
    key := key;
    ipath := ipath;
    clear :
      context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t;
    fold_keys : forall {a : Set},
      context -> a ->
      (key -> a -> Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a;
    keys :
      context -> Tezos_protocol_environment_alpha__Environment.Lwt.t (list key);
    resolve :
      context -> list string ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t (list key);
    remove_rec :
      context -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t context;
    copy :
      context -> key -> key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          context);
    Make_set : functor;
    Make_map : functor;
    Make_carbonated_map : functor;
    Raw_context : Raw_context.T.signature (ipath t);
  }.
  Arguments signature : clear implicits.
End Indexed_raw_context.

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

include Qty_repr.Make (struct
  let id = "tez"
end)

type t = qty

type tez = qty

let encoding = Data_encoding.def "mutez" @@ encoding

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

(* ❌ Cannot include this kind of module expression *)
include

Definition t := qty.

Definition tez := qty.

Definition encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding qty :=
  op_atat
    (let arg := Data_encoding.def "mutez" % string in
    fun eta => arg None None eta) encoding.

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

type t

type tez = t

include Qty_repr.S with type qty := t

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Parameter t : Set.

Definition tez := t.

(* extensible_type Tezos_protocol_environment_alpha__Environment.Error_monad.error *)

(* extensible_type Tezos_protocol_environment_alpha__Environment.Error_monad.error *)

(* extensible_type Tezos_protocol_environment_alpha__Environment.Error_monad.error *)

(* extensible_type Tezos_protocol_environment_alpha__Environment.Error_monad.error *)

(* extensible_type Tezos_protocol_environment_alpha__Environment.Error_monad.error *)

Parameter id : string.

Parameter zero : t.

Parameter one_mutez : t.

Parameter one_cent : t.

Parameter fifty_cents : t.

Parameter one : t.

Parameter op_minusquestion :
  t -> t -> Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult t.

Parameter op_plusquestion :
  t -> t -> Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult t.

Parameter op_starquestion :
  t -> int64 ->
  Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult t.

Parameter op_divquestion :
  t -> int64 ->
  Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult t.

Parameter to_mutez : t -> int64.

Parameter of_mutez : int64 -> option t.

Parameter of_mutez_exn : int64 -> t.

Parameter add_exn : t -> t -> t.

Parameter mul_exn : t -> Z -> t.

Parameter encoding :
  Tezos_protocol_environment_alpha__Environment.Data_encoding.t t.

Parameter to_int64 : t -> int64.

Parameter op_eq : t -> t -> bool.

Parameter op_ltgt : t -> t -> bool.

Parameter op_lt : t -> t -> bool.

Parameter op_lteq : t -> t -> bool.

Parameter op_gteq : t -> t -> bool.

Parameter op_gt : t -> t -> bool.

Parameter compare : t -> t -> Z.

Parameter equal : t -> t -> bool.

Parameter max : t -> t -> t.

Parameter min : t -> t -> t.

Parameter pp :
  Tezos_protocol_environment_alpha__Environment.Format.formatter -> t -> unit.

Parameter of_string : string -> option t.

Parameter to_string : t -> string.

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

include Time

type time = t

type error += Timestamp_add (* `Permanent *)

type error += Timestamp_sub (* `Permanent *)

let () =
  register_error_kind
    `Permanent
    ~id:"timestamp_add"
    ~title:"Timestamp add"
    ~description:"Overflow when adding timestamps."
    ~pp:(fun ppf () -> Format.fprintf ppf "Overflow when adding timestamps.")
    Data_encoding.empty
    (function Timestamp_add -> Some () | _ -> None)
    (fun () -> Timestamp_add) ;
  register_error_kind
    `Permanent
    ~id:"timestamp_sub"
    ~title:"Timestamp sub"
    ~description:"Substracting timestamps resulted in negative period."
    ~pp:(fun ppf () ->
      Format.fprintf ppf "Substracting timestamps resulted in negative period.")
    Data_encoding.empty
    (function Timestamp_sub -> Some () | _ -> None)
    (fun () -> Timestamp_sub)

let of_seconds s = try Some (of_seconds (Int64.of_string s)) with _ -> None

let to_seconds = to_seconds

let to_seconds_string s = Int64.to_string (to_seconds s)

let pp = pp_hum

let ( +? ) x y =
  try ok (add x (Period_repr.to_seconds y)) with _exn -> error Timestamp_add

let ( -? ) x y = record_trace Timestamp_sub (Period_repr.of_seconds (diff x y))

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Export Time.

Definition time := t.

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Top-level evaluations are considered as an error as sources of side-effects *)
Compute
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "timestamp_add" % string "Timestamp add" % string
      "Overflow when adding timestamps." % string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let 'tt := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Overflow when adding timestamps." % string
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
                "Overflow when adding timestamps." % string)))
      Data_encoding.empty
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Timestamp_add
          => Some tt
        | _ => None
        end)
      (fun function_parameter =>
        let 'tt := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Timestamp_add)
    in
  register_error_kind
    (* ❌ Variants not supported *)
    variant "timestamp_sub" % string "Timestamp sub" % string
    "Substracting timestamps resulted in negative period." % string
    (Some
      (fun ppf =>
        fun function_parameter =>
          let 'tt := function_parameter in
          Format.fprintf ppf
            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                "Substracting timestamps resulted in negative period." % string
                Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
              "Substracting timestamps resulted in negative period." % string)))
    Data_encoding.empty
    (fun function_parameter =>
      match function_parameter with
      | Tezos_protocol_environment_alpha__Environment.Error_monad.Timestamp_sub
        => Some tt
      | _ => None
      end)
    (fun function_parameter =>
      let 'tt := function_parameter in
      Tezos_protocol_environment_alpha__Environment.Error_monad.Timestamp_sub).

Definition of_seconds (s : string) : option t :=
  (* ❌ Try-with are not handled *)
  try (Some (of_seconds (Int64.of_string s))).

Definition to_seconds : t -> int64 := to_seconds.

Definition to_seconds_string (s : t) : string := Int64.to_string (to_seconds s).

Definition pp
  : Tezos_protocol_environment_alpha__Environment.Format.formatter -> t -> unit :=
  pp_hum.

Definition op_plusquestion
  (x : t) (y : Tezos_raw_protocol_alpha.Period_repr.period)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult t :=
  (* ❌ Try-with are not handled *)
  try (ok (add x (Period_repr.to_seconds y))).

Definition op_minusquestion (x : t) (y : t)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    Tezos_raw_protocol_alpha.Period_repr.period :=
  record_trace
    Tezos_protocol_environment_alpha__Environment.Error_monad.Timestamp_sub
    (Period_repr.of_seconds (diff x y)).

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

include module type of struct
  include Time
end

type time = t

val pp : Format.formatter -> t -> unit

val of_seconds : string -> time option

val to_seconds_string : time -> string

val ( +? ) : time -> Period_repr.t -> time tzresult

val ( -? ) : time -> time -> Period_repr.t tzresult

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Definition t := Tezos_base__TzPervasives.Time.Protocol.t.

Parameter op_eq : t -> t -> bool.

Parameter op_ltgt : t -> t -> bool.

Parameter op_lt : t -> t -> bool.

Parameter op_lteq : t -> t -> bool.

Parameter op_gteq : t -> t -> bool.

Parameter op_gt : t -> t -> bool.

Parameter compare : t -> t -> Z.

Parameter equal : t -> t -> bool.

Parameter max : t -> t -> t.

Parameter min : t -> t -> t.

Parameter add : t -> int64 -> t.

Parameter diff : t -> t -> int64.

Parameter of_seconds : int64 -> t.

Parameter to_seconds : t -> int64.

Parameter of_notation : string -> option t.

Parameter of_notation_exn : string -> t.

Parameter to_notation : t -> string.

Parameter encoding :
  Tezos_protocol_environment_alpha__Environment.Data_encoding.t t.

Parameter rfc_encoding :
  Tezos_protocol_environment_alpha__Environment.Data_encoding.t t.

Parameter pp_hum :
  Tezos_protocol_environment_alpha__Environment.Format.formatter -> t -> unit.

Definition time := t.

Parameter pp :
  Tezos_protocol_environment_alpha__Environment.Format.formatter -> t -> unit.

Parameter of_seconds : string -> option time.

Parameter to_seconds_string : time -> string.

Parameter op_plusquestion :
  time -> Tezos_raw_protocol_alpha.Period_repr.t ->
  Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult time.

Parameter op_minusquestion :
  time -> time ->
  Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    Tezos_raw_protocol_alpha.Period_repr.t.

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

type proposal = Protocol_hash.t

type ballot = Yay | Nay | Pass

let ballot_encoding =
  let of_int8 = function
    | 0 ->
        Yay
    | 1 ->
        Nay
    | 2 ->
        Pass
    | _ ->
        invalid_arg "ballot_of_int8"
  in
  let to_int8 = function Yay -> 0 | Nay -> 1 | Pass -> 2 in
  let open Data_encoding in
  (* union *)
  splitted
    ~binary:(conv to_int8 of_int8 int8)
    ~json:(string_enum [("yay", Yay); ("nay", Nay); ("pass", Pass)])

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Definition proposal :=
  Tezos_protocol_environment_alpha__Environment.Protocol_hash.t.

Inductive ballot : Set :=
| Yay : ballot
| Nay : ballot
| Pass : ballot.

Definition ballot_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding ballot :=
  let of_int8 (function_parameter : Z) : ballot :=
    match function_parameter with
    | 0 => Yay
    | 1 => Nay
    | 2 => Pass
    | _ => invalid_arg "ballot_of_int8" % string
    end in
  let to_int8 (function_parameter : ballot) : Z :=
    match function_parameter with
    | Yay => 0
    | Nay => 1
    | Pass => 2
    end in
  splitted
    (string_enum
      (cons ("yay" % string, Yay)
        (cons ("nay" % string, Nay) (cons ("pass" % string, Pass) []))))
    (conv to_int8 of_int8 None int8).

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

(** a protocol change proposal *)
type proposal = Protocol_hash.t

(** votes can be for, against or neutral.
    Neutral serves to count towards a quorum *)
type ballot = Yay | Nay | Pass

val ballot_encoding : ballot Data_encoding.t

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Definition proposal :=
  Tezos_protocol_environment_alpha__Environment.Protocol_hash.t.

Inductive ballot : Set :=
| Yay : ballot
| Nay : ballot
| Pass : ballot.

Parameter ballot_encoding :
  Tezos_protocol_environment_alpha__Environment.Data_encoding.t ballot.

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

let recorded_proposal_count_for_delegate ctxt proposer =
  Storage.Vote.Proposals_count.get_option ctxt proposer
  >>=? function None -> return 0 | Some count -> return count

let record_proposal ctxt proposal proposer =
  recorded_proposal_count_for_delegate ctxt proposer
  >>=? fun count ->
  Storage.Vote.Proposals_count.init_set ctxt proposer (count + 1)
  >>= fun ctxt ->
  Storage.Vote.Proposals.add ctxt (proposal, proposer)
  >>= fun ctxt -> return ctxt

let get_proposals ctxt =
  Storage.Vote.Proposals.fold
    ctxt
    ~init:(ok Protocol_hash.Map.empty)
    ~f:(fun (proposal, delegate) acc ->
      (* Assuming the same listings is used at votings *)
      Storage.Vote.Listings.get ctxt delegate
      >>=? fun weight ->
      Lwt.return
        ( acc
        >>? fun acc ->
        let previous =
          match Protocol_hash.Map.find_opt proposal acc with
          | None ->
              0l
          | Some x ->
              x
        in
        ok (Protocol_hash.Map.add proposal (Int32.add weight previous) acc) ))

let clear_proposals ctxt =
  Storage.Vote.Proposals_count.clear ctxt
  >>= fun ctxt -> Storage.Vote.Proposals.clear ctxt

type ballots = {yay : int32; nay : int32; pass : int32}

let ballots_encoding =
  let open Data_encoding in
  conv
    (fun {yay; nay; pass} -> (yay, nay, pass))
    (fun (yay, nay, pass) -> {yay; nay; pass})
  @@ obj3 (req "yay" int32) (req "nay" int32) (req "pass" int32)

let has_recorded_ballot = Storage.Vote.Ballots.mem

let record_ballot = Storage.Vote.Ballots.init

let get_ballots ctxt =
  Storage.Vote.Ballots.fold
    ctxt
    ~f:(fun delegate ballot (ballots : ballots tzresult) ->
      (* Assuming the same listings is used at votings *)
      Storage.Vote.Listings.get ctxt delegate
      >>=? fun weight ->
      let count = Int32.add weight in
      Lwt.return
        ( ballots
        >>? fun ballots ->
        match ballot with
        | Yay ->
            ok {ballots with yay = count ballots.yay}
        | Nay ->
            ok {ballots with nay = count ballots.nay}
        | Pass ->
            ok {ballots with pass = count ballots.pass} ))
    ~init:(ok {yay = 0l; nay = 0l; pass = 0l})

let get_ballot_list = Storage.Vote.Ballots.bindings

let clear_ballots = Storage.Vote.Ballots.clear

let listings_encoding =
  Data_encoding.(
    list
      (obj2 (req "pkh" Signature.Public_key_hash.encoding) (req "rolls" int32)))

let freeze_listings ctxt =
  Roll_storage.fold ctxt (ctxt, 0l) ~f:(fun _roll delegate (ctxt, total) ->
      (* TODO use snapshots *)
      let delegate = Signature.Public_key.hash delegate in
      Storage.Vote.Listings.get_option ctxt delegate
      >>=? (function None -> return 0l | Some count -> return count)
      >>=? fun count ->
      Storage.Vote.Listings.init_set ctxt delegate (Int32.succ count)
      >>= fun ctxt -> return (ctxt, Int32.succ total))
  >>=? fun (ctxt, total) ->
  Storage.Vote.Listings_size.init ctxt total >>=? fun ctxt -> return ctxt

let listing_size = Storage.Vote.Listings_size.get

let in_listings = Storage.Vote.Listings.mem

let get_listings = Storage.Vote.Listings.bindings

let clear_listings ctxt =
  Storage.Vote.Listings.clear ctxt
  >>= fun ctxt ->
  Storage.Vote.Listings_size.remove ctxt >>= fun ctxt -> return ctxt

let get_current_period_kind = Storage.Vote.Current_period_kind.get

let set_current_period_kind = Storage.Vote.Current_period_kind.set

let get_current_quorum ctxt =
  Storage.Vote.Participation_ema.get ctxt
  >>=? fun participation_ema ->
  let quorum_min = Constants_storage.quorum_min ctxt in
  let quorum_max = Constants_storage.quorum_max ctxt in
  let quorum_diff = Int32.sub quorum_max quorum_min in
  return
    Int32.(add quorum_min (div (mul participation_ema quorum_diff) 100_00l))

let get_participation_ema = Storage.Vote.Participation_ema.get

let set_participation_ema = Storage.Vote.Participation_ema.set

let get_current_proposal = Storage.Vote.Current_proposal.get

let init_current_proposal = Storage.Vote.Current_proposal.init

let clear_current_proposal = Storage.Vote.Current_proposal.delete

let init ctxt =
  (* participation EMA is in centile of a percentage *)
  let participation_ema = Constants_storage.quorum_max ctxt in
  Storage.Vote.Participation_ema.init ctxt participation_ema
  >>=? fun ctxt ->
  Storage.Vote.Current_period_kind.init ctxt Proposal
  >>=? fun ctxt -> return ctxt

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Definition recorded_proposal_count_for_delegate
  (ctxt : Tezos_raw_protocol_alpha.Storage.Vote.Proposals_count.context)
  (proposer : Tezos_raw_protocol_alpha.Storage.Vote.Proposals_count.key)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Storage.Vote.Proposals_count.value) :=
  op_gtgteqquestion (Storage.Vote.Proposals_count.get_option ctxt proposer)
    (fun function_parameter =>
      match function_parameter with
      | None => __return 0
      | Some count => __return count
      end).

Definition record_proposal
  (ctxt : Tezos_raw_protocol_alpha.Storage.Vote.Proposals_count.context)
  (proposal : Tezos_protocol_environment_alpha__Environment.Protocol_hash.t)
  (proposer : Tezos_raw_protocol_alpha.Storage.Vote.Proposals_count.key)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  op_gtgteqquestion (recorded_proposal_count_for_delegate ctxt proposer)
    (fun count =>
      op_gtgteq
        (Storage.Vote.Proposals_count.init_set ctxt proposer (op_plus count 1))
        (fun ctxt =>
          op_gtgteq (Storage.Vote.Proposals.add ctxt (proposal, proposer))
            (fun ctxt => __return ctxt))).

Definition get_proposals
  (ctxt : Tezos_raw_protocol_alpha.Storage.Vote.Proposals.context)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_protocol_environment_alpha__Environment.Protocol_hash.Map.t int32)) :=
  Storage.Vote.Proposals.fold ctxt (ok Protocol_hash.Map.empty)
    (fun function_parameter =>
      let '(proposal, delegate) := function_parameter in
      fun acc =>
        op_gtgteqquestion (Storage.Vote.Listings.get ctxt delegate)
          (fun weight =>
            Lwt.__return
              (op_gtgtquestion acc
                (fun acc =>
                  let previous :=
                    match Protocol_hash.Map.find_opt proposal acc with
                    | None =>
                      (* ❌ Constant of type int32 is converted to int *)
                      0
                    | Some x => x
                    end in
                  ok
                    (Protocol_hash.Map.add proposal (Int32.add weight previous)
                      acc))))).

Definition clear_proposals
  (ctxt : Tezos_raw_protocol_alpha.Storage.Vote.Proposals_count.context)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    Tezos_raw_protocol_alpha.Raw_context.t :=
  op_gtgteq (Storage.Vote.Proposals_count.clear ctxt)
    (fun ctxt => Storage.Vote.Proposals.clear ctxt).

Module ballots.
  Record record := {
    yay : int32;
    nay : int32;
    pass : int32 }.
End ballots.
Definition ballots := ballots.record.

Definition ballots_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding ballots :=
  op_atat
    (let arg :=
      conv
        (fun function_parameter =>
          let '{|
            ballots.yay := yay; ballots.nay := nay; ballots.pass := pass |} :=
            function_parameter in
          (yay, nay, pass))
        (fun function_parameter =>
          let '(yay, nay, pass) := function_parameter in
          {| ballots.yay := yay; ballots.nay := nay; ballots.pass := pass |}) in
    fun eta => arg None eta)
    (obj3 (req None None "yay" % string __int32_value)
      (req None None "nay" % string __int32_value)
      (req None None "pass" % string __int32_value)).

Definition has_recorded_ballot
  : Tezos_raw_protocol_alpha.Storage.Vote.Ballots.context ->
  Tezos_raw_protocol_alpha.Storage.Vote.Ballots.key ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t bool :=
  Storage.Vote.Ballots.mem.

Definition record_ballot
  : Tezos_raw_protocol_alpha.Storage.Vote.Ballots.context ->
  Tezos_raw_protocol_alpha.Storage.Vote.Ballots.key ->
  Tezos_raw_protocol_alpha.Storage.Vote.Ballots.value ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) := Storage.Vote.Ballots.init.

Definition get_ballots
  (ctxt : Tezos_raw_protocol_alpha.Storage.Vote.Ballots.context)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult ballots) :=
  Storage.Vote.Ballots.fold ctxt
    (ok
      {|
        ballots.yay :=
          (* ❌ Constant of type int32 is converted to int *)
          0;
        ballots.nay :=
          (* ❌ Constant of type int32 is converted to int *)
          0;
        ballots.pass :=
          (* ❌ Constant of type int32 is converted to int *)
          0 |})
    (fun delegate =>
      fun ballot =>
        fun ballots =>
          op_gtgteqquestion (Storage.Vote.Listings.get ctxt delegate)
            (fun weight =>
              let count := Int32.add weight in
              Lwt.__return
                (op_gtgtquestion ballots
                  (fun ballots =>
                    match ballot with
                    | Tezos_raw_protocol_alpha.Vote_repr.Yay =>
                      ok
                        (* ❌ Record substitution not handled *)
                        record_substitution
                    | Tezos_raw_protocol_alpha.Vote_repr.Nay =>
                      ok
                        (* ❌ Record substitution not handled *)
                        record_substitution
                    | Tezos_raw_protocol_alpha.Vote_repr.Pass =>
                      ok
                        (* ❌ Record substitution not handled *)
                        record_substitution
                    end)))).

Definition get_ballot_list
  : Tezos_raw_protocol_alpha.Storage.Vote.Ballots.context ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (list
      (Tezos_raw_protocol_alpha.Storage.Vote.Ballots.key *
        Tezos_raw_protocol_alpha.Storage.Vote.Ballots.value)) :=
  Storage.Vote.Ballots.bindings.

Definition clear_ballots
  : Tezos_raw_protocol_alpha.Storage.Vote.Ballots.context ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    Tezos_raw_protocol_alpha.Raw_context.t := Storage.Vote.Ballots.clear.

Definition listings_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    (list
      (Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t
        * int32)) :=
  __list_value None
    (obj2 (req None None "pkh" % string Signature.Public_key_hash.encoding)
      (req None None "rolls" % string __int32_value)).

Definition freeze_listings (ctxt : Tezos_raw_protocol_alpha.Raw_context.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  op_gtgteqquestion
    (Roll_storage.fold ctxt
      (fun _roll =>
        fun delegate =>
          fun function_parameter =>
            let '(ctxt, total) := function_parameter in
            let delegate := Signature.Public_key.__hash_value delegate in
            op_gtgteqquestion
              (op_gtgteqquestion
                (Storage.Vote.Listings.get_option ctxt delegate)
                (fun function_parameter =>
                  match function_parameter with
                  | None =>
                    __return
                      (* ❌ Constant of type int32 is converted to int *)
                      0
                  | Some count => __return count
                  end))
              (fun count =>
                op_gtgteq
                  (Storage.Vote.Listings.init_set ctxt delegate
                    (Int32.succ count))
                  (fun ctxt => __return (ctxt, (Int32.succ total)))))
      (ctxt,
        (* ❌ Constant of type int32 is converted to int *)
        0))
    (fun function_parameter =>
      let '(ctxt, total) := function_parameter in
      op_gtgteqquestion (Storage.Vote.Listings_size.init ctxt total)
        (fun ctxt => __return ctxt)).

Definition listing_size
  : Tezos_raw_protocol_alpha.Storage.Vote.Listings_size.context ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Storage.Vote.Listings_size.value) :=
  Storage.Vote.Listings_size.get.

Definition in_listings
  : Tezos_raw_protocol_alpha.Storage.Vote.Listings.context ->
  Tezos_raw_protocol_alpha.Storage.Vote.Listings.key ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t bool :=
  Storage.Vote.Listings.mem.

Definition get_listings
  : Tezos_raw_protocol_alpha.Storage.Vote.Listings.context ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (list
      (Tezos_raw_protocol_alpha.Storage.Vote.Listings.key *
        Tezos_raw_protocol_alpha.Storage.Vote.Listings.value)) :=
  Storage.Vote.Listings.bindings.

Definition clear_listings
  (ctxt : Tezos_raw_protocol_alpha.Storage.Vote.Listings.context)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  op_gtgteq (Storage.Vote.Listings.clear ctxt)
    (fun ctxt =>
      op_gtgteq (Storage.Vote.Listings_size.remove ctxt)
        (fun ctxt => __return ctxt)).

Definition get_current_period_kind
  : Tezos_raw_protocol_alpha.Storage.Vote.Current_period_kind.context ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Storage.Vote.Current_period_kind.value) :=
  Storage.Vote.Current_period_kind.get.

Definition set_current_period_kind
  : Tezos_raw_protocol_alpha.Storage.Vote.Current_period_kind.context ->
  Tezos_raw_protocol_alpha.Storage.Vote.Current_period_kind.value ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  Storage.Vote.Current_period_kind.set.

Definition get_current_quorum
  (ctxt : Tezos_raw_protocol_alpha.Storage.Vote.Participation_ema.context)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult int32) :=
  op_gtgteqquestion (Storage.Vote.Participation_ema.get ctxt)
    (fun participation_ema =>
      let quorum_min := Constants_storage.quorum_min ctxt in
      let quorum_max := Constants_storage.quorum_max ctxt in
      let quorum_diff := Int32.sub quorum_max quorum_min in
      __return
        (add quorum_min
          (div (mul participation_ema quorum_diff)
            (* ❌ Constant of type int32 is converted to int *)
            10000))).

Definition get_participation_ema
  : Tezos_raw_protocol_alpha.Storage.Vote.Participation_ema.context ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Storage.Vote.Participation_ema.value) :=
  Storage.Vote.Participation_ema.get.

Definition set_participation_ema
  : Tezos_raw_protocol_alpha.Storage.Vote.Participation_ema.context ->
  Tezos_raw_protocol_alpha.Storage.Vote.Participation_ema.value ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  Storage.Vote.Participation_ema.set.

Definition get_current_proposal
  : Tezos_raw_protocol_alpha.Storage.Vote.Current_proposal.context ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Storage.Vote.Current_proposal.value) :=
  Storage.Vote.Current_proposal.get.

Definition init_current_proposal
  : Tezos_raw_protocol_alpha.Storage.Vote.Current_proposal.context ->
  Tezos_raw_protocol_alpha.Storage.Vote.Current_proposal.value ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  Storage.Vote.Current_proposal.init.

Definition clear_current_proposal
  : Tezos_raw_protocol_alpha.Storage.Vote.Current_proposal.context ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  Storage.Vote.Current_proposal.delete.

Definition init (ctxt : Tezos_raw_protocol_alpha.Raw_context.context)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  let participation_ema := Constants_storage.quorum_max ctxt in
  op_gtgteqquestion (Storage.Vote.Participation_ema.init ctxt participation_ema)
    (fun ctxt =>
      op_gtgteqquestion
        (Storage.Vote.Current_period_kind.init ctxt
          Tezos_raw_protocol_alpha.Voting_period_repr.Proposal)
        (fun ctxt => __return ctxt)).

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

(** Manages all the voting related storage in Storage.Vote.  *)

(** Records a protocol proposal with the delegate that proposed it. *)
val record_proposal :
  Raw_context.t ->
  Protocol_hash.t ->
  Signature.Public_key_hash.t ->
  Raw_context.t tzresult Lwt.t

val recorded_proposal_count_for_delegate :
  Raw_context.t -> Signature.Public_key_hash.t -> int tzresult Lwt.t

(** Computes for each proposal how many delegates proposed it. *)
val get_proposals : Raw_context.t -> int32 Protocol_hash.Map.t tzresult Lwt.t

val clear_proposals : Raw_context.t -> Raw_context.t Lwt.t

(** Counts of the votes *)
type ballots = {yay : int32; nay : int32; pass : int32}

val ballots_encoding : ballots Data_encoding.t

val has_recorded_ballot :
  Raw_context.t -> Signature.Public_key_hash.t -> bool Lwt.t

(** Records a vote for a delegate, returns a {!Storage_error Existing_key} if
    the vote was already registered *)
val record_ballot :
  Raw_context.t ->
  Signature.Public_key_hash.t ->
  Vote_repr.ballot ->
  Raw_context.t tzresult Lwt.t

(** Computes the sum of the current ballots weighted by stake. *)
val get_ballots : Raw_context.t -> ballots tzresult Lwt.t

val get_ballot_list :
  Raw_context.t -> (Signature.Public_key_hash.t * Vote_repr.ballot) list Lwt.t

val clear_ballots : Raw_context.t -> Raw_context.t Lwt.t

val listings_encoding :
  (Signature.Public_key_hash.t * int32) list Data_encoding.t

(** Populates [!Storage.Vote.Listings] using the currently existing rolls and
    sets Listings_size. Delegates without rolls are not included in the listing. *)
val freeze_listings : Raw_context.t -> Raw_context.t tzresult Lwt.t

val clear_listings : Raw_context.t -> Raw_context.t tzresult Lwt.t

(** Returns the sum of all rolls of all delegates. *)
val listing_size : Raw_context.t -> int32 tzresult Lwt.t

(** Verifies the presence of a delegate in the listing. *)
val in_listings : Raw_context.t -> Signature.Public_key_hash.t -> bool Lwt.t

val get_listings :
  Raw_context.t -> (Signature.Public_key_hash.t * int32) list Lwt.t

val get_current_quorum : Raw_context.t -> int32 tzresult Lwt.t

val get_participation_ema : Raw_context.t -> int32 tzresult Lwt.t

val set_participation_ema :
  Raw_context.t -> int32 -> Raw_context.t tzresult Lwt.t

val get_current_period_kind :
  Raw_context.t -> Voting_period_repr.kind tzresult Lwt.t

val set_current_period_kind :
  Raw_context.t -> Voting_period_repr.kind -> Raw_context.t tzresult Lwt.t

val get_current_proposal : Raw_context.t -> Protocol_hash.t tzresult Lwt.t

val init_current_proposal :
  Raw_context.t -> Protocol_hash.t -> Raw_context.t tzresult Lwt.t

val clear_current_proposal : Raw_context.t -> Raw_context.t tzresult Lwt.t

(** Sets the initial quorum to 80% and period kind to proposal. *)
val init : Raw_context.t -> Raw_context.t tzresult Lwt.t

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Parameter record_proposal :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Protocol_hash.t ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t).

Parameter recorded_proposal_count_for_delegate :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult Z).

Parameter get_proposals :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_protocol_environment_alpha__Environment.Protocol_hash.Map.t int32)).

Parameter clear_proposals :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    Tezos_raw_protocol_alpha.Raw_context.t.

Module ballots.
  Record record := {
    yay : int32;
    nay : int32;
    pass : int32 }.
End ballots.
Definition ballots := ballots.record.

Parameter ballots_encoding :
  Tezos_protocol_environment_alpha__Environment.Data_encoding.t ballots.

Parameter has_recorded_ballot :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t bool.

Parameter record_ballot :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Tezos_raw_protocol_alpha.Vote_repr.ballot ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t).

Parameter get_ballots :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult ballots).

Parameter get_ballot_list :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (list
      (Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t
        * Tezos_raw_protocol_alpha.Vote_repr.ballot)).

Parameter clear_ballots :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    Tezos_raw_protocol_alpha.Raw_context.t.

Parameter listings_encoding :
  Tezos_protocol_environment_alpha__Environment.Data_encoding.t
    (list
      (Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t
        * int32)).

Parameter freeze_listings :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t).

Parameter clear_listings :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t).

Parameter listing_size :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult int32).

Parameter in_listings :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t bool.

Parameter get_listings :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (list
      (Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t
        * int32)).

Parameter get_current_quorum :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult int32).

Parameter get_participation_ema :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult int32).

Parameter set_participation_ema :
  Tezos_raw_protocol_alpha.Raw_context.t -> int32 ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t).

Parameter get_current_period_kind :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Voting_period_repr.kind).

Parameter set_current_period_kind :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Voting_period_repr.kind ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t).

Parameter get_current_proposal :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_protocol_environment_alpha__Environment.Protocol_hash.t).

Parameter init_current_proposal :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Protocol_hash.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t).

Parameter clear_current_proposal :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t).

Parameter init :
  Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t).

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

type t = int32

type voting_period = t

include (Compare.Int32 : Compare.S with type t := t)

let encoding = Data_encoding.int32

let pp ppf level = Format.fprintf ppf "%ld" level

let rpc_arg =
  let construct voting_period = Int32.to_string voting_period in
  let destruct str =
    match Int32.of_string str with
    | exception _ ->
        Error "Cannot parse voting period"
    | voting_period ->
        Ok voting_period
  in
  RPC_arg.make
    ~descr:"A voting period"
    ~name:"voting_period"
    ~construct
    ~destruct
    ()

let root = 0l

let succ = Int32.succ

let to_int32 l = l

let of_int32_exn l =
  if Compare.Int32.(l >= 0l) then l
  else invalid_arg "Voting_period_repr.of_int32"

type kind = Proposal | Testing_vote | Testing | Promotion_vote

let kind_encoding =
  let open Data_encoding in
  union
    ~tag_size:`Uint8
    [ case
        (Tag 0)
        ~title:"Proposal"
        (constant "proposal")
        (function Proposal -> Some () | _ -> None)
        (fun () -> Proposal);
      case
        (Tag 1)
        ~title:"Testing_vote"
        (constant "testing_vote")
        (function Testing_vote -> Some () | _ -> None)
        (fun () -> Testing_vote);
      case
        (Tag 2)
        ~title:"Testing"
        (constant "testing")
        (function Testing -> Some () | _ -> None)
        (fun () -> Testing);
      case
        (Tag 3)
        ~title:"Promotion_vote"
        (constant "promotion_vote")
        (function Promotion_vote -> Some () | _ -> None)
        (fun () -> Promotion_vote) ]

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Definition t := int32.

Definition voting_period := t.

Export Compare.Int32.

Definition encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding int32 :=
  Data_encoding.__int32_value.

Definition pp
  (ppf : Tezos_protocol_environment_alpha__Environment.Format.formatter)
  (level : int32) : unit :=
  Format.fprintf ppf
    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int32
        Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int_d
        Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
        Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_precision
        Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
      "%ld" % string) level.

Definition rpc_arg
  : Tezos_protocol_environment_alpha__Environment.RPC_arg.arg int32 :=
  let construct (voting_period : int32) : string :=
    Int32.to_string voting_period in
  let destruct (str : string)
    : Tezos_protocol_environment_alpha__Environment.Pervasives.result int32
      string :=
    let 'voting_period := Int32.of_string str in
    Tezos_protocol_environment_alpha__Environment.Pervasives.Ok voting_period in
  RPC_arg.make (Some "A voting period" % string) "voting_period" % string
    destruct construct tt.

Definition root : int32 :=
  (* ❌ Constant of type int32 is converted to int *)
  0.

Definition succ : int32 -> int32 := Int32.succ.

Definition to_int32 {A : Set} (l : A) : A := l.

Definition of_int32_exn
  (l : Tezos_protocol_environment_alpha__Environment.Compare.Int32.t)
  : Tezos_protocol_environment_alpha__Environment.Compare.Int32.t :=
  if
    op_gteq l
      (* ❌ Constant of type int32 is converted to int *)
      0 then
    l
  else
    invalid_arg "Voting_period_repr.of_int32" % string.

Inductive kind : Set :=
| Proposal : kind
| Testing_vote : kind
| Testing : kind
| Promotion_vote : kind.

Definition kind_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding kind :=
  union
    (Some
      (* ❌ Variants not supported *)
      variant)
    (cons
      (__case_value "Proposal" % string None
        (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag 0)
        (constant "proposal" % string)
        (fun function_parameter =>
          match function_parameter with
          | Proposal => Some tt
          | _ => None
          end)
        (fun function_parameter =>
          let 'tt := function_parameter in
          Proposal))
      (cons
        (__case_value "Testing_vote" % string None
          (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag 1)
          (constant "testing_vote" % string)
          (fun function_parameter =>
            match function_parameter with
            | Testing_vote => Some tt
            | _ => None
            end)
          (fun function_parameter =>
            let 'tt := function_parameter in
            Testing_vote))
        (cons
          (__case_value "Testing" % string None
            (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag 2)
            (constant "testing" % string)
            (fun function_parameter =>
              match function_parameter with
              | Testing => Some tt
              | _ => None
              end)
            (fun function_parameter =>
              let 'tt := function_parameter in
              Testing))
          (cons
            (__case_value "Promotion_vote" % string None
              (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag 3)
              (constant "promotion_vote" % string)
              (fun function_parameter =>
                match function_parameter with
                | Promotion_vote => Some tt
                | _ => None
                end)
              (fun function_parameter =>
                let 'tt := function_parameter in
                Promotion_vote)) [])))).

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

(** A voting period can be of 4 kinds and is uniquely identified as a counter
    since the root. *)

type t

type voting_period = t

val encoding : voting_period Data_encoding.t

val rpc_arg : voting_period RPC_arg.arg

val pp : Format.formatter -> voting_period -> unit

include Compare.S with type t := voting_period

val to_int32 : voting_period -> int32

val of_int32_exn : int32 -> voting_period

val root : voting_period

val succ : voting_period -> voting_period

type kind =
  | Proposal  (** protocols can be proposed *)
  | Testing_vote  (** a proposal can be voted *)
  | Testing  (** winning proposal is forked on a testnet *)
  | Promotion_vote  (** activation can be voted *)

val kind_encoding : kind Data_encoding.t

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Parameter t : Set.

Definition voting_period := t.

Parameter encoding :
  Tezos_protocol_environment_alpha__Environment.Data_encoding.t voting_period.

Parameter rpc_arg :
  Tezos_protocol_environment_alpha__Environment.RPC_arg.arg voting_period.

Parameter pp :
  Tezos_protocol_environment_alpha__Environment.Format.formatter ->
  voting_period -> unit.

Parameter op_eq : voting_period -> voting_period -> bool.

Parameter op_ltgt : voting_period -> voting_period -> bool.

Parameter op_lt : voting_period -> voting_period -> bool.

Parameter op_lteq : voting_period -> voting_period -> bool.

Parameter op_gteq : voting_period -> voting_period -> bool.

Parameter op_gt : voting_period -> voting_period -> bool.

Parameter compare : voting_period -> voting_period -> Z.

Parameter equal : voting_period -> voting_period -> bool.

Parameter max : voting_period -> voting_period -> voting_period.

Parameter min : voting_period -> voting_period -> voting_period.

Parameter to_int32 : voting_period -> int32.

Parameter of_int32_exn : int32 -> voting_period.

Parameter root : voting_period.

Parameter succ : voting_period -> voting_period.

Inductive kind : Set :=
| Proposal : kind
| Testing_vote : kind
| Testing : kind
| Promotion_vote : kind.

Parameter kind_encoding :
  Tezos_protocol_environment_alpha__Environment.Data_encoding.t kind.

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Alpha_context

module S = struct
  let path = RPC_path.(open_root / "votes")

  let ballots =
    RPC_service.get_service
      ~description:"Sum of ballots casted so far during a voting period."
      ~query:RPC_query.empty
      ~output:Vote.ballots_encoding
      RPC_path.(path / "ballots")

  let ballot_list =
    RPC_service.get_service
      ~description:"Ballots casted so far during a voting period."
      ~query:RPC_query.empty
      ~output:
        Data_encoding.(
          list
            (obj2
               (req "pkh" Signature.Public_key_hash.encoding)
               (req "ballot" Vote.ballot_encoding)))
      RPC_path.(path / "ballot_list")

  let current_period_kind =
    RPC_service.get_service
      ~description:"Current period kind."
      ~query:RPC_query.empty
      ~output:Voting_period.kind_encoding
      RPC_path.(path / "current_period_kind")

  let current_quorum =
    RPC_service.get_service
      ~description:"Current expected quorum."
      ~query:RPC_query.empty
      ~output:Data_encoding.int32
      RPC_path.(path / "current_quorum")

  let listings =
    RPC_service.get_service
      ~description:
        "List of delegates with their voting weight, in number of rolls."
      ~query:RPC_query.empty
      ~output:Vote.listings_encoding
      RPC_path.(path / "listings")

  let proposals =
    RPC_service.get_service
      ~description:"List of proposals with number of supporters."
      ~query:RPC_query.empty
      ~output:(Protocol_hash.Map.encoding Data_encoding.int32)
      RPC_path.(path / "proposals")

  let current_proposal =
    RPC_service.get_service
      ~description:"Current proposal under evaluation."
      ~query:RPC_query.empty
      ~output:(Data_encoding.option Protocol_hash.encoding)
      RPC_path.(path / "current_proposal")
end

let register () =
  let open Services_registration in
  register0 S.ballots (fun ctxt () () -> Vote.get_ballots ctxt) ;
  register0 S.ballot_list (fun ctxt () () -> Vote.get_ballot_list ctxt >|= ok) ;
  register0 S.current_period_kind (fun ctxt () () ->
      Vote.get_current_period_kind ctxt) ;
  register0 S.current_quorum (fun ctxt () () -> Vote.get_current_quorum ctxt) ;
  register0 S.proposals (fun ctxt () () -> Vote.get_proposals ctxt) ;
  register0 S.listings (fun ctxt () () -> Vote.get_listings ctxt >|= ok) ;
  register0 S.current_proposal (fun ctxt () () ->
      (* this would be better implemented using get_option in get_current_proposal *)
      Vote.get_current_proposal ctxt
      >>= function
      | Ok p ->
          return_some p
      | Error (Raw_context.Storage_error (Missing_key _) :: _) ->
          return_none
      | Error _ as e ->
          Lwt.return e)

let ballots ctxt block = RPC_context.make_call0 S.ballots ctxt block () ()

let ballot_list ctxt block =
  RPC_context.make_call0 S.ballot_list ctxt block () ()

let current_period_kind ctxt block =
  RPC_context.make_call0 S.current_period_kind ctxt block () ()

let current_quorum ctxt block =
  RPC_context.make_call0 S.current_quorum ctxt block () ()

let listings ctxt block = RPC_context.make_call0 S.listings ctxt block () ()

let proposals ctxt block = RPC_context.make_call0 S.proposals ctxt block () ()

let current_proposal ctxt block =
  RPC_context.make_call0 S.current_proposal ctxt block () ()

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Import Alpha_context.

Module S.
  Definition path
    : Tezos_protocol_environment_alpha__Environment.RPC_path.path
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context :=
    op_div open_root "votes" % string.
  
  Definition ballots
    : Tezos_protocol_environment_alpha__Environment.RPC_service.service
      (* `GET *) unit
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context unit
      unit Tezos_raw_protocol_alpha.Alpha_context.Vote.ballots :=
    RPC_service.get_service
      (Some "Sum of ballots casted so far during a voting period." % string)
      RPC_query.empty Vote.ballots_encoding (op_div path "ballots" % string).
  
  Definition ballot_list
    : Tezos_protocol_environment_alpha__Environment.RPC_service.service
      (* `GET *) unit
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context unit
      unit
      (list
        (Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t
          * Tezos_raw_protocol_alpha.Alpha_context.Vote.ballot)) :=
    RPC_service.get_service
      (Some "Ballots casted so far during a voting period." % string)
      RPC_query.empty
      (__list_value None
        (obj2 (req None None "pkh" % string Signature.Public_key_hash.encoding)
          (req None None "ballot" % string Vote.ballot_encoding)))
      (op_div path "ballot_list" % string).
  
  Definition current_period_kind
    : Tezos_protocol_environment_alpha__Environment.RPC_service.service
      (* `GET *) unit
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context unit
      unit Tezos_raw_protocol_alpha.Alpha_context.Voting_period.kind :=
    RPC_service.get_service (Some "Current period kind." % string)
      RPC_query.empty Voting_period.kind_encoding
      (op_div path "current_period_kind" % string).
  
  Definition current_quorum
    : Tezos_protocol_environment_alpha__Environment.RPC_service.service
      (* `GET *) unit
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context unit
      unit int32 :=
    RPC_service.get_service (Some "Current expected quorum." % string)
      RPC_query.empty Data_encoding.__int32_value
      (op_div path "current_quorum" % string).
  
  Definition listings
    : Tezos_protocol_environment_alpha__Environment.RPC_service.service
      (* `GET *) unit
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context unit
      unit
      (list
        (Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t
          * int32)) :=
    RPC_service.get_service
      (Some
        "List of delegates with their voting weight, in number of rolls." %
          string) RPC_query.empty Vote.listings_encoding
      (op_div path "listings" % string).
  
  Definition proposals
    : Tezos_protocol_environment_alpha__Environment.RPC_service.service
      (* `GET *) unit
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context unit
      unit
      (Tezos_protocol_environment_alpha__Environment.Protocol_hash.Map.t int32) :=
    RPC_service.get_service
      (Some "List of proposals with number of supporters." % string)
      RPC_query.empty (Protocol_hash.Map.encoding Data_encoding.__int32_value)
      (op_div path "proposals" % string).
  
  Definition current_proposal
    : Tezos_protocol_environment_alpha__Environment.RPC_service.service
      (* `GET *) unit
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context unit
      unit
      (option Tezos_protocol_environment_alpha__Environment.Protocol_hash.t) :=
    RPC_service.get_service (Some "Current proposal under evaluation." % string)
      RPC_query.empty (Data_encoding.__option_value Protocol_hash.encoding)
      (op_div path "current_proposal" % string).
End S.

Definition register (function_parameter : unit) : unit :=
  let 'tt := function_parameter in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register0 S.ballots
      (fun ctxt =>
        fun function_parameter =>
          let 'tt := function_parameter in
          fun function_parameter =>
            let 'tt := function_parameter in
            Vote.get_ballots ctxt) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register0 S.ballot_list
      (fun ctxt =>
        fun function_parameter =>
          let 'tt := function_parameter in
          fun function_parameter =>
            let 'tt := function_parameter in
            op_gtpipeeq (Vote.get_ballot_list ctxt) ok) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register0 S.current_period_kind
      (fun ctxt =>
        fun function_parameter =>
          let 'tt := function_parameter in
          fun function_parameter =>
            let 'tt := function_parameter in
            Vote.get_current_period_kind ctxt) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register0 S.current_quorum
      (fun ctxt =>
        fun function_parameter =>
          let 'tt := function_parameter in
          fun function_parameter =>
            let 'tt := function_parameter in
            Vote.get_current_quorum ctxt) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register0 S.proposals
      (fun ctxt =>
        fun function_parameter =>
          let 'tt := function_parameter in
          fun function_parameter =>
            let 'tt := function_parameter in
            Vote.get_proposals ctxt) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register0 S.listings
      (fun ctxt =>
        fun function_parameter =>
          let 'tt := function_parameter in
          fun function_parameter =>
            let 'tt := function_parameter in
            op_gtpipeeq (Vote.get_listings ctxt) ok) in
  register0 S.current_proposal
    (fun ctxt =>
      fun function_parameter =>
        let 'tt := function_parameter in
        fun function_parameter =>
          let 'tt := function_parameter in
          op_gtgteq (Vote.get_current_proposal ctxt)
            (fun function_parameter =>
              match function_parameter with
              | Tezos_protocol_environment_alpha__Environment.Pervasives.Ok p =>
                return_some p
              |
                Tezos_protocol_environment_alpha__Environment.Pervasives.Error
                  (cons
                    (Tezos_protocol_environment_alpha__Environment.Error_monad.Storage_error
                      (Tezos_raw_protocol_alpha.Raw_context.Missing_key _ _)) _)
                => return_none
              |
                (Tezos_protocol_environment_alpha__Environment.Pervasives.Error
                  _) as e => Lwt.__return e
              end)).

Definition ballots {D E G I K L a b c i o q : Set}
  (ctxt :
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
        (* `POST *) unit + (* `PUT *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> D ->
    q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
          (* `POST *) unit + (* `PUT *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
      -> D -> a -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (G * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
            (* `POST *) unit + (* `PUT *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o -> D -> a -> b -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (I * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
              (* `POST *) unit + (* `PUT *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o -> D -> a -> b -> c -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (K * a * b * c * q * i * o)) * L)))) * L * D) (block : D)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      Tezos_raw_protocol_alpha.Alpha_context.Vote.ballots) :=
  RPC_context.make_call0 S.ballots ctxt block tt tt.

Definition ballot_list {D E G I K L a b c i o q : Set}
  (ctxt :
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
        (* `POST *) unit + (* `PUT *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> D ->
    q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
          (* `POST *) unit + (* `PUT *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
      -> D -> a -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (G * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
            (* `POST *) unit + (* `PUT *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o -> D -> a -> b -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (I * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
              (* `POST *) unit + (* `PUT *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o -> D -> a -> b -> c -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (K * a * b * c * q * i * o)) * L)))) * L * D) (block : D)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      (list
        (Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t
          * Tezos_raw_protocol_alpha.Alpha_context.Vote.ballot))) :=
  RPC_context.make_call0 S.ballot_list ctxt block tt tt.

Definition current_period_kind {D E G I K L a b c i o q : Set}
  (ctxt :
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
        (* `POST *) unit + (* `PUT *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> D ->
    q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
          (* `POST *) unit + (* `PUT *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
      -> D -> a -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (G * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
            (* `POST *) unit + (* `PUT *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o -> D -> a -> b -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (I * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
              (* `POST *) unit + (* `PUT *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o -> D -> a -> b -> c -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (K * a * b * c * q * i * o)) * L)))) * L * D) (block : D)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      Tezos_raw_protocol_alpha.Alpha_context.Voting_period.kind) :=
  RPC_context.make_call0 S.current_period_kind ctxt block tt tt.

Definition current_quorum {D E G I K L a b c i o q : Set}
  (ctxt :
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
        (* `POST *) unit + (* `PUT *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> D ->
    q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
          (* `POST *) unit + (* `PUT *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
      -> D -> a -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (G * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
            (* `POST *) unit + (* `PUT *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o -> D -> a -> b -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (I * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
              (* `POST *) unit + (* `PUT *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o -> D -> a -> b -> c -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (K * a * b * c * q * i * o)) * L)))) * L * D) (block : D)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      int32) := RPC_context.make_call0 S.current_quorum ctxt block tt tt.

Definition listings {D E G I K L a b c i o q : Set}
  (ctxt :
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
        (* `POST *) unit + (* `PUT *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> D ->
    q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
          (* `POST *) unit + (* `PUT *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
      -> D -> a -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (G * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
            (* `POST *) unit + (* `PUT *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o -> D -> a -> b -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (I * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
              (* `POST *) unit + (* `PUT *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o -> D -> a -> b -> c -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (K * a * b * c * q * i * o)) * L)))) * L * D) (block : D)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      (list
        (Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t
          * int32))) := RPC_context.make_call0 S.listings ctxt block tt tt.

Definition proposals {D E G I K L a b c i o q : Set}
  (ctxt :
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
        (* `POST *) unit + (* `PUT *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> D ->
    q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
          (* `POST *) unit + (* `PUT *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
      -> D -> a -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (G * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
            (* `POST *) unit + (* `PUT *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o -> D -> a -> b -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (I * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
              (* `POST *) unit + (* `PUT *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o -> D -> a -> b -> c -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (K * a * b * c * q * i * o)) * L)))) * L * D) (block : D)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      (Tezos_protocol_environment_alpha__Environment.Protocol_hash.Map.t int32)) :=
  RPC_context.make_call0 S.proposals ctxt block tt tt.

Definition current_proposal {D E G I K L a b c i o q : Set}
  (ctxt :
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
        (* `POST *) unit + (* `PUT *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> D ->
    q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
          (* `POST *) unit + (* `PUT *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
      -> D -> a -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (G * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
            (* `POST *) unit + (* `PUT *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o -> D -> a -> b -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (I * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
            ((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
              (* `POST *) unit + (* `PUT *) unit)
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o -> D -> a -> b -> c -> q -> i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (K * a * b * c * q * i * o)) * L)))) * L * D) (block : D)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      (option Tezos_protocol_environment_alpha__Environment.Protocol_hash.t)) :=
  RPC_context.make_call0 S.current_proposal ctxt block tt tt.

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Alpha_context

val ballots : 'a #RPC_context.simple -> 'a -> Vote.ballots shell_tzresult Lwt.t

val ballot_list :
  'a #RPC_context.simple ->
  'a ->
  (Signature.Public_key_hash.t * Vote.ballot) list shell_tzresult Lwt.t

val current_period_kind :
  'a #RPC_context.simple -> 'a -> Voting_period.kind shell_tzresult Lwt.t

val current_quorum :
  'a #RPC_context.simple -> 'a -> Int32.t shell_tzresult Lwt.t

val listings :
  'a #RPC_context.simple ->
  'a ->
  (Signature.Public_key_hash.t * int32) list shell_tzresult Lwt.t

val proposals :
  'a #RPC_context.simple ->
  'a ->
  Int32.t Protocol_hash.Map.t shell_tzresult Lwt.t

val current_proposal :
  'a #RPC_context.simple -> 'a -> Protocol_hash.t option shell_tzresult Lwt.t

val register : unit -> unit

Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Parameter ballots : forall {E F H J K a b c i o q : Set},
  (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
    ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit +
      (* `PATCH *) unit)
    Tezos_protocol_environment_alpha__Environment.RPC_context.t
    Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> a ->
  q -> i ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult o))
    * (E * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit
        + (* `PATCH *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
    a -> a -> q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (F * a * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
          (* `POST *) unit + (* `PATCH *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
        q i o -> a -> a -> b -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (H * a * b * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
            (* `POST *) unit + (* `PATCH *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
            b) * c) q i o -> a -> a -> b -> c -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (J * a * b * c * q * i * o)) * K)))) * K * a -> a ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      Tezos_raw_protocol_alpha.Alpha_context.Vote.ballots).

Parameter ballot_list : forall {E F H J K a b c i o q : Set},
  (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
    ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit +
      (* `PATCH *) unit)
    Tezos_protocol_environment_alpha__Environment.RPC_context.t
    Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> a ->
  q -> i ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult o))
    * (E * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit
        + (* `PATCH *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
    a -> a -> q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (F * a * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
          (* `POST *) unit + (* `PATCH *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
        q i o -> a -> a -> b -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (H * a * b * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
            (* `POST *) unit + (* `PATCH *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
            b) * c) q i o -> a -> a -> b -> c -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (J * a * b * c * q * i * o)) * K)))) * K * a -> a ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      (list
        (Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t
          * Tezos_raw_protocol_alpha.Alpha_context.Vote.ballot))).

Parameter current_period_kind : forall {E F H J K a b c i o q : Set},
  (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
    ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit +
      (* `PATCH *) unit)
    Tezos_protocol_environment_alpha__Environment.RPC_context.t
    Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> a ->
  q -> i ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult o))
    * (E * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit
        + (* `PATCH *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
    a -> a -> q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (F * a * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
          (* `POST *) unit + (* `PATCH *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
        q i o -> a -> a -> b -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (H * a * b * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
            (* `POST *) unit + (* `PATCH *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
            b) * c) q i o -> a -> a -> b -> c -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (J * a * b * c * q * i * o)) * K)))) * K * a -> a ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      Tezos_raw_protocol_alpha.Alpha_context.Voting_period.kind).

Parameter current_quorum : forall {E F H J K a b c i o q : Set},
  (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
    ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit +
      (* `PATCH *) unit)
    Tezos_protocol_environment_alpha__Environment.RPC_context.t
    Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> a ->
  q -> i ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult o))
    * (E * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit
        + (* `PATCH *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
    a -> a -> q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (F * a * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
          (* `POST *) unit + (* `PATCH *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
        q i o -> a -> a -> b -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (H * a * b * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
            (* `POST *) unit + (* `PATCH *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
            b) * c) q i o -> a -> a -> b -> c -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (J * a * b * c * q * i * o)) * K)))) * K * a -> a ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      Tezos_protocol_environment_alpha__Environment.Int32.t).

Parameter listings : forall {E F H J K a b c i o q : Set},
  (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
    ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit +
      (* `PATCH *) unit)
    Tezos_protocol_environment_alpha__Environment.RPC_context.t
    Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> a ->
  q -> i ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult o))
    * (E * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit
        + (* `PATCH *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
    a -> a -> q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (F * a * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
          (* `POST *) unit + (* `PATCH *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
        q i o -> a -> a -> b -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (H * a * b * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
            (* `POST *) unit + (* `PATCH *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
            b) * c) q i o -> a -> a -> b -> c -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (J * a * b * c * q * i * o)) * K)))) * K * a -> a ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      (list
        (Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t
          * int32))).

Parameter proposals : forall {E F H J K a b c i o q : Set},
  (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
    ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit +
      (* `PATCH *) unit)
    Tezos_protocol_environment_alpha__Environment.RPC_context.t
    Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> a ->
  q -> i ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult o))
    * (E * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit
        + (* `PATCH *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
    a -> a -> q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (F * a * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
          (* `POST *) unit + (* `PATCH *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
        q i o -> a -> a -> b -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (H * a * b * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
            (* `POST *) unit + (* `PATCH *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
            b) * c) q i o -> a -> a -> b -> c -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (J * a * b * c * q * i * o)) * K)))) * K * a -> a ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      (Tezos_protocol_environment_alpha__Environment.Protocol_hash.Map.t
        Tezos_protocol_environment_alpha__Environment.Int32.t)).

Parameter current_proposal : forall {E F H J K a b c i o q : Set},
  (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
    ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit +
      (* `PATCH *) unit)
    Tezos_protocol_environment_alpha__Environment.RPC_context.t
    Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> a ->
  q -> i ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult o))
    * (E * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit
        + (* `PATCH *) unit)
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
    a -> a -> q -> i ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        o)) * (F * a * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
        ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
          (* `POST *) unit + (* `PATCH *) unit)
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
        q i o -> a -> a -> b -> q -> i ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          o)) * (H * a * b * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
          ((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
            (* `POST *) unit + (* `PATCH *) unit)
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
            b) * c) q i o -> a -> a -> b -> c -> q -> i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (J * a * b * c * q * i * o)) * K)))) * K * a -> a ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      (option Tezos_protocol_environment_alpha__Environment.Protocol_hash.t)).

Parameter register : unit -> unit.